Copier/Coller colonnes classeur 1 à 6 vers classeur cible [Résolu]

Source1 = Array("J", "H", "I", "AG", "AB", "V", "W", "Y", "Z")
CibleSource1 = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")

Source2 = Array("AK", "AM", "W", "X", "Y", "Z", "AI", "AJ", "AP", "AS", "AE", "AG")
CibleSource2 =  Array("J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V")

Sub a()
Dim Test$, arrWBK
Dim Source1(), Source2(), Cible()
Dim MaPlage As Range, DerLig As Long, Wk5 As Workbook
'Ajout
Dim Ws5 As Worksheet
arrWBK = Array("classeur1.xls", "classeur2.xls","classeur3.xls", "classeur4.xls")
'Ajout
Set Wk5 = Workbooks("classeur5.xls")
'Ajout
Set Ws5 = Wk5.Worksheets("Feuil1")
    Source1 = Array("J", "H", "I", "AG", "AB", "V", "W", "Y", "Z")
    Source2 = Array("AK", "AM", "W", "X", "Y", "Z", "AI", "AJ", "AP", "AS", "AE", "AG")
    Cible = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V")
    'A remanier
    For i = 0 To UBound(arrWBK)
        For j = 0 To UBound(Source1)
        With Workbooks(arrWBK(i)).Sheets(1)
            DerLig = .Cells(65536, Source1(j)).End(xlUp).Row
            MsgBox "Derlig= " & DerLig
            Set MaPlage = Cells(2, CStr(Source1(j))).Resize(DerLig)
            Test = Workbooks(arrWBK(i)).Name & ": " & .Name & ": " & MaPlage.Address
            MsgBox Test
            'Ajout
            MaPlage.Copy Destination:=Ws5.Range(Cible(j) & 2)
            Set MaPlage = Nothing
        End With
        Next j
    Next i
    'Ajout
    Set Ws5 = Nothing
    'Ajout
    Set Wk5 = Nothing
End Sub

Sub ab()
Dim arrWBK, derligg&, Ws5 As Worksheet
Dim Source1(), Cible()
Dim MaPlage As Range, derlig As Long, Wk5 As Workbook
arrWBK = Array("classeur2", "classeur3")
Set Wk5 = ThisWorkbook 'Workbooks("classeur5.xls")
Set Ws5 = Wk5.Worksheets("Feuil1")
    Source1 = Array("H", "I", "J")
    Cible = Array("A", "B", "C")
    'A remanier
    For i = 0 To UBound(arrWBK)
        For j = 0 To UBound(Source1)
        With Workbooks(arrWBK(i)).Sheets(1)
            derlig = .Cells(65536, Source1(j)).End(xlUp).Row
            Set MaPlage = .Cells(2, CStr(Source1(j))).Resize(derlig)
            derligg = Ws5.Cells(65536, Cible(j)).End(xlUp).Row
            MaPlage.Copy Destination:=Ws5.Cells(derligg + 1, Cible(j))
            Set MaPlage = Nothing
        End With
        Next j
    Next i
    Set Ws5 = Nothing: Set Wk5 = Nothing
End Sub

Sub ab()
Dim arrWBK, arrWBK2, derligg&, Ws5 As Worksheet
Dim Source1(), Source2(), Cible()
Dim MaPlage As Range, derlig As Long, Wk5 As Workbook
arrWBK = Array("classeur1.xls", "classeur2.xls")
arrWBK2 = Array("classeur3.xls", "classeur4.xls")
Set Wk5 = ThisWorkbook 'Workbooks("classeur5.xls")
Set Ws5 = Wk5.Worksheets("Feuil1")
    Source1 = Array("J", "H", "I", "AG", "AB")
    Source2 = Array("Z")
    Cible = Array("A", "B", "C", "D", "E")
    Cible2 = Array("F")
    'A remanier
    For i = 0 To UBound(arrWBK)
        For j = 0 To UBound(Source1)
        With Workbooks(arrWBK(i)).Sheets(1)
            derlig = .Cells(65536, Source1(j)).End(xlUp).Row
            Set MaPlage = .Cells(2, CStr(Source1(j))).Resize(derlig)
            derligg = Ws5.Cells(65536, Cible(j)).End(xlUp).Row
            MaPlage.Copy Destination:=Ws5.Cells(derligg + 1, Cible(j))
            Set MaPlage = Nothing
        End With
        Next j
    Next i
    For i = 0 To UBound(arrWBK2)
        For j = 0 To UBound(Source2)
        With Workbooks(arrWBK2(i)).Sheets(1)
            derlig = .Cells(65536, Source2(j)).End(xlUp).Row
            Set MaPlage = .Cells(2, CStr(Source2(j))).Resize(derlig)
            derligg = Ws5.Cells(65536, Cible2(j)).End(xlUp).Row
            MaPlage.Copy Destination:=Ws5.Cells(derligg + 1, Cible2(j))
            Set MaPlage = Nothing
        End With
        Next j
    Next i
    Set Ws5 = Nothing: Set Wk5 = Nothing
End Sub