每隔n次將宏復制/粘貼到另一個工作簿的宏

Question

我正在將一些單元格從一個封閉的工作簿粘貼到另一工作簿。 我已經成功粘貼了兩個單元格，但是，我想復制從D9開始的單元格，然后每9個復制一次，直到在SourceWb上找到空單元格，然后將它們粘貼到其他工作簿TargetWb中，從A列第2行開始等等水平（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