用于每隔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

您需要使用动态Variant Array和动态范围。

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