用於複製/粘貼單元格到另一個工作簿的宏的宏

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