Question

我希望将一些已关闭的工作簿中的一些单元格粘贴到另一个工作簿。我成功地粘贴了几个单元格，但是，我想从D9开始复制单元格，然后每隔9日复制一次，直到在SourceWb上找到空单元格，并将它们粘贴到从A列第2行开始的其他工作簿TargetWb中，等等（B2，C2，D2等）

Sub PullClosedData()

Dim filePath As String
Dim SourceWb As Workbook
Dim TargetWb As Workbook

Set TargetWb = ActiveWorkbook

filePath = TargetWb.Sheets("System").Range("A1").Value
Set SourceWb = Workbooks.Open(filePath)

SourceWb.Sheets("results").Range("D9").Copy 
Destination:=TargetWb.Sheets("Data").Range("A2")
SourceWb.Sheets("results").Range("D18").Copy 
Destination:=TargetWb.Sheets("Data").Range("B2")

SourceWb.Save
TargetWb.Save
TargetWb.Close False

MsgBox "Complete!"

End Sub

提前感谢您的支持。

Answer 1

您需要使用动态变体数组和动态范围。

Sub PullClosedData()

Dim filePath As String
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim sWs As Worksheet, tWs As Worksheet
Dim i As Long, n As Long, r As Long, vR() As Variant

Set TargetWb = ActiveWorkbook

filePath = TargetWb.Sheets("System").Range("A1").Value
Set SourceWb = Workbooks.Open(filePath)
Set sWs = SourceWb.Sheets("resuts")
Set tWs = TargetWb.Sheets("Data")
With sWs
    r = .Range("d" & Rows.Count).End(xlUp)
    For i = 9 To r Step 9
        n = n + 1
        ReDim Preserve vR(1 To n)  '<~~ increase dynamic array.
        vR(n) = .Range("d" & i)
    Next i
End With
tWs.Range("a2").Resize(1, n) = vR


SourceWb.Save
TargetWb.Save
TargetWb.Close False

MsgBox "Complete!"

End Sub

用于将每个n的单元格复制/粘贴到另一个工作簿的宏

1 个答案: