Macro pour copier/coller des cellules tous les n à un autre classeur

Question

Je cherche à coller des cellules d'un classeur fermé vers un autre classeur. J'ai réussi à coller quelques cellules avec succès, cependant, je veux copier des cellules commençant à D9, puis tous les 9 jusqu'à ce que des cellules vides soient trouvées sur SourceWb, et les coller dans l'autre classeur TargetWb commençant à la colonne A, rangée 2 et ainsi de suite horizontalement (B2, C2, D2, etc.)

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 

Merci d'avance pour votre soutien.

Answer 1

Vous devez utiliser une matrice de variants dynamique et une plage dynamique.

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