Fusion des colonnes(fichier diffèrent) ayant la même valeur d'entête
M
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 SubLe resultat:
Normalement la valeur de la colonne Mois doit se situer a Code D/I
Merci pour votre aide
A
Bonjour,
Sans classeur, pas facile (pour moi) de voir d'où vient le décalage...
A+