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

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