Fusion des colonnes(fichier diffèrent) ayant la même valeur d'entête

Bonjour a tous,

Je rencontre un soucis dans mon algo VBA, celui ci fonctionne mais les colonne sont décaler.
Comme indiquer dans le titre j'ai développer un algo VBA qui va ouvrir un fichier B, vérifier les valeurs de ses cellules d'entête et les comparer avec les cellules d'entête d'un autre fichier A(l'algo se trouve dans celui ci). Si les entêtes du fichier B ont le même noms alors je copie et colle les colonnes dans mon fichier A bien entendu je les colles dans la colonne du fichier A qui a le même nom.

Ci dessous le code.

Option Explicit

Sub Fusion()

Application.ScreenUpdating = False

Dim der_ligne1
Dim der_ligne2
Dim dercol1
Dim dercol2
Dim col1
Dim col2
Dim Ncol1
Dim Ncol2
Dim libele As String
Dim libele2 As String
Dim LTR1
Dim LTR2
Dim wb As Workbook
Dim FichierOuvert As Worksheet

Set wb = Workbooks.Open("Nom.Fichier")

der_ligne1 = Workbooks("P1auto.xlsm").Sheets("Performance Source").Cells(Rows.Count, 4).End(xlUp).Row 'définir la dernière ligne utilisée
der_ligne2 = wb.Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row 'définir la dernière ligne utilisée

'determine le nombre de colonnes non vides
dercol1 = Workbooks("P1auto.xlsm").Sheets("Performance Source").Cells.Find("*", , , , xlByColumns, xlPrevious).Column 'définir le dernier numéro de colonne pour arrêter la boucle
dercol2 = wb.Sheets("Feuil1").Cells.Find("*", , , , xlByColumns, xlPrevious).Column 'définir le dernier numéro de colonne pour arrêter la boucle

For col1 = 2 To dercol1
Ncol1 = Cells(1, col1).Column ' renvoi le numéro de colonne trouvée corresponante
libele = CStr(Cells(3, Ncol1))

        LTR1 = Left((Cells(3, Ncol1).Address), 3) 'récupérer uniquement la lettre de l'adresse

'-----------------------------------------------------------------------------boucle 2 --------------------------------------------------------

    For col2 = 3 To dercol2
        Ncol2 = Cells(1, col2).Column ' renvoi le numéro de colonne trouvée corresponante
        libele2 = wb.Sheets("Feuil1").Cells(3, Ncol2)
        If libele = libele2 Then  'CStr(Cells(3, Ncol2)) Then

        LTR2 = Left((Cells(3, Ncol2).Address), 3) 'récupérer uniquement la lettre de l'adresse

        Dim AireSource As Range, CelluleCible As Range

        Set CelluleCible = Workbooks("P1auto.xlsm").Sheets("Performance Source").Range(LTR1 & der_ligne1 + 1) 'définir la cellule vers laquelle coller la plage de données
        Set AireSource = wb.Sheets("Feuil1").Range(LTR2 & "4:" & LTR2 & der_ligne2) ' définir la plage de données à copier

        AireSource.Copy Destination:=CelluleCible 'copie d'une feuille à l'autre

        Set CelluleCible = Nothing 'raz variable
        Set AireSource = Nothing 'raz variable

        GoTo suite  'sortir de la boucle
        End If

    Next

'--------------------------------------------------------------------fin boucle 2 ---------------------------------------------------------------

suite:

Next

MsgBox ("terminé")

End Sub

Le resultat:

capture

Normalement la valeur de la colonne Mois doit se situer a Code D/I

Merci pour votre aide

Bonjour,

Sans classeur, pas facile (pour moi) de voir d'où vient le décalage...

A+

Rechercher des sujets similaires à "fusion colonnes fichier different ayant meme valeur entete"