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

Sub copier()

Dim Source1(), Source2(), Source3(), Source4(), Cible(), Tablo
Dim MaPlage As Range
Dim DerLig As Long
'sources
Dim Wk1 As Workbook
Dim Wk2 As Workbook
Dim Wk3 As Workbook
Dim Wk4 As Workbook
'cible
Dim Wk5 As Workbook
'sources
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet
Dim Ws4 As Worksheet
'cible
Dim Ws5 As Worksheet
    Set Wk1 = Workbooks("classeur1.xls") 
    Set Wk2 = Workbooks("classeur2.xls") 
    Set Wk3 = Workbooks("classeur3.xls") 
    Set Wk4 = Workbooks("classeur4.xls") 
    Set Wk5 = Workbooks("classeur5.xls") 
    Set Ws1 = Wk1.Worksheets("Feuil1") 
    Set Ws2 = Wk2.Worksheets("Feuil1") 
    Set Ws3 = Wk3.Worksheets("Feuil1") 
    Set Ws4 = Wk4.Worksheets("Feuil1") 
    Set Ws5 = Wk5.Worksheets("Feuil1")  
    Source1 = Array("J", "H", "I", "AG", "AB", "V", "W", "Y", "Z")
    Source2 = Array("J", "H", "I", "AG", "AB", "V", "W", "Y", "Z")
    Source3 = Array("AK", "AM", "W", "X", "Y","Z","AI","AJ","AP","AS","AE","AG")
    Source4 = 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(Source)
        DerLig = Ws1.Range(Source(i) & Ws1.Rows.Count).End(xlUp).Row
        Set MaPlage = Ws1.Range(Ws1.Cells(2, Source(i)), Ws1.Cells(DerLig, Source(i)))
        MaPlage.Copy Destination:=Ws7.Range(Cible(i) & 2)
        Set MaPlage = Nothing
    Next
    'Est-ce que les set ici sont obligatoires?
    Set Ws1 = Nothing
    Set Ws2 = Nothing
    Set Ws3 = Nothing
    Set Ws4 = Nothing
    Set Ws5 = Nothing
    Set Wk1 = Nothing
    Set Wk2 = Nothing
    Set Wk3 = Nothing
    Set Wk4 = Nothing
    Set Wk5 = Nothing
End Sub

Sub copier()

Dim Source1(), Source2(), Cible(), Tablo
Dim MaPlage As Range
Dim DerLig As Long
'sources
Dim Wk1 As Workbook
Dim Wk2 As Workbook
Dim Wk3 As Workbook
Dim Wk4 As Workbook
'cible
Dim Wk5 As Workbook
'sources
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Ws3 As Worksheet
Dim Ws4 As Worksheet
'cible
Dim Ws5 As Worksheet
    Set Wk1 = Workbooks("classeur1.xls") 
    Set Wk2 = Workbooks("classeur2.xls") 
    Set Wk3 = Workbooks("classeur3.xls") 
    Set Wk4 = Workbooks("classeur4.xls") 
    Set Wk5 = Workbooks("classeur5.xls") 
    Set Ws1 = Wk1.Worksheets("Feuil1") 
    Set Ws2 = Wk2.Worksheets("Feuil1") 
    Set Ws3 = Wk3.Worksheets("Feuil1") 
    Set Ws4 = Wk4.Worksheets("Feuil1") 
    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(Source)
        DerLig = Ws1.Range(Source(i) & Ws1.Rows.Count).End(xlUp).Row
        Set MaPlage = Ws1.Range(Ws1.Cells(2, Source(i)), Ws1.Cells(DerLig, Source(i)))
        MaPlage.Copy Destination:=Ws5.Range(Cible(i) & 2)
        Set MaPlage = Nothing
    Next
    Set Ws1 = Nothing
    Set Ws2 = Nothing
    Set Ws3 = Nothing
    Set Ws4 = Nothing
    Set Ws5 = Nothing
    Set Wk1 = Nothing
    Set Wk2 = Nothing
    Set Wk3 = Nothing
    Set Wk4 = Nothing
    Set Wk5 = Nothing
End Sub

Sub a()
Dim Test$, arrWBK
Dim Source1(), Source2(), Cible(), Tablo
Dim MaPlage As Range, DerLig As Long, Wk5 As Workbook
arrWBK = Array("classeur1.xls", "classeur2.xls", "classeur3.xls", "classeur4.xls")

Set Wk5 = ThisWorkbook
    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
            Set MaPlage = Nothing
        End With
        Next j
    Next i
End Sub

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 a()
Dim Source1
Dim Cible
Source1 = Array("J", "H", "I", "AG", "AB", "V", "W", "Y", "Z")
Cible = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U","V")
Msgbox Ubound(Source1)
Msgbox Ubound(Cible)
End Sub