Copier des colonnes des classeur fermé dans class final

Bonjour

J'ai 150 classeurs excel (dans un même dossier)

Je souhaiterai copier/coller tout ça dans un classeur final indépendant déjà créé (Fichier cumuler)

dans les 150 fichiers les colonnes suivent "Agent, Nom , prénom, adresse, Tel1, Tel2, date_entré "

mais les entête des colonne nom pas sur le même ordre dans les 150 Fichiers

exemple

le classeur1 les entête classé " adresse, Tel1, Nom , prénom Tel2, date_entré , Agent

le classeur2 les entête classé " Tel1,adresse, Nom , prénom Tel2, Agent ,date_entré , '

le classeur3 les entête classé " Tel1,adresse, Nom , prénom Tel2, Agent ,date_entré , '

jamais bien trouver une macro vba pour automatisé cette opération

merci

Bonjour,

une proposition

Option Compare Text
Sub cumulfichier()
    Dim eni(7)
    Set wb = ThisWorkbook
    Set wso = Sheets(1)
    nl = wso.Cells(Rows.Count, 1).End(xlUp).Row
    f = Dir(wb.Path & "\*.xls*")
    While f <> ""
        If f <> wb.Name Then
            Set wbi = Workbooks.Open(wb.Path & "\" & f)
            Set wsi = Sheets(1)
            For i = 1 To 7
                For j = 1 To 7
                    If Trim(wsi.Cells(1, i)) = wso.Cells(1, j) Then eni(i) = j: Exit For
                Next j
                If eni(i) = 0 Then
                 MsgBox "pas parvenu à identifier la colonne " & wso.Cells(1, i)
                 wb.Activate
                 Set cj = Application.InputBox("à quelle colonne le champ " & wso.Cells(1, i) & " correspond-il ?", Type:=8)
                 eni(i) = cj.Column
                 End If
            Next i
            dl = wsi.Cells(Rows.Count, 1).End(xlUp).Row
            For i = 2 To dl
                nl = nl + 1
                For j = 1 To 7
                    wso.Cells(nl, eni(j)) = wsi.Cells(i, j)
                Next j
            Next i
            wbi.Close
        End If
        f = Dir()
    Wend
End Sub

merci

mais il des colonnes qui n'ont pas copier (la colonne adresse)

Bonjour,

effectivement il y a quelques bugs,

voici une version corrigée.

Option Compare Text
Sub cumulfichier()
    Dim eni(7)
    Set wb = ThisWorkbook
    Set wso = Sheets(1)
    nl = wso.Cells(Rows.Count, 1).End(xlUp).Row
    f = Dir(wb.Path & "\*.xls*")
    While f <> ""
        If f <> wb.Name Then
            Set wbi = Workbooks.Open(wb.Path & "\" & f)
            Set wsi = Sheets(1)
            For i = 1 To 7
            eni(i) = 0
                For j = 1 To 7
                    If Trim(wsi.Cells(1, i)) = Trim(wso.Cells(1, j)) Then eni(i) = j: Exit For
                Next j
                If eni(i) = 0 Then
                 MsgBox "fichier : " & f & ", pas parvenu à trouver la colonne " & wsi.Cells(1, i) & " dans le classeur cumul"
                 wb.Activate
                 Set cj = Application.InputBox("Sélectionner la colonne du classeur cumul qui correspond à " & wso.Cells(1, i), Type:=8)
                 eni(i) = cj.Column
                 End If
            Next i
            dl = wsi.UsedRange.Rows.Count
            For i = 2 To dl
                nl = nl + 1
                For j = 1 To 7
                    wso.Cells(nl, eni(j)) = wsi.Cells(i, j)
                Next j
            Next i
            wbi.Close
        End If
        f = Dir()
    Wend
    MsgBox "cumul terminé"
End Sub

intégré en pj, lancer la macro via alt-F8

merci bien