Problème d'Alignement

Question

Je souhaiterai de l'aide afin de résoudre mon problème Sur le fichier ci-joint, dans les colonnes A et L j'ai des valeurs. Malheureusement il y a des décalages en ligne du fait que certaines valeurs sont uniquement sur la colonne A et d'autres uniquement sur la colonne L. Ma mission est de refaire ce tableau en alignant les valeurs identiques dans A et L. Si quelqu'un a une idée sans passer par du VBA si possible ? Merci beaucoup...

ThauThème · Accepted Answer

Re,

Désolé pour cette réponse tardive, j'avais perdu le fil...

Toujour avec un second onglet nommé Feuil2 et le résultat dans cet onglet :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OS (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Derniere ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim R As Range 'déclare la variable R (Recherche)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD
OD.Cells.Clear 'efface le contenu de l'onglet destination OD
OS.Rows(1).Copy 'copie la première ligne de l'onglet source
OD.Range("A1").PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
OS.Rows(1 & ":" & 2).Copy OD.Range("A1") 'copie les deux premières ligne de l'onglet source et les colle dans A1 de l'onglet destination
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la derniere ligne éditée DL de la colonne A de l'onglet source
OS.Range("A3:K" & DL).Copy OD.Range("A3") 'copie la partie gauche du tableau et la colle dans A3 de l'onglet destination
DL = OS.Cells(Application.Rows.Count, "L").End(xlUp).Row 'définit la derniere ligne éditée DL de la colonne L de l'onglet source
For I = 3 To DL 'boucle sur toutes les lignes I de 3 a DL
    'définit la recherche R (recherche la valeur exacte de la cellule ligne I colonne 12 dans la colonne 1 de l'onglet source OS
    Set R = OS.Columns(1).Find(OS.Cells(I, 12).Value, , xlValues, xlWhole)
    'si aucune occurrence n'est trouvée, copie la cellule ligne I, colonne 12 redimensionnée à deux colonne et la colle à la fin de la colonne A de l'onglet destination
    If R Is Nothing Then OS.Cells(I, 12).Resize(1, 2).Copy OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0): Set R = Nothing
Next I 'prochaine ligne de la boucle
DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la derniere ligne éditée DL de la colonne A de l'onglet destination
OD.Range("A3:K" & DL).Sort OD.Range("A3"), xlAscending, Header:=xlNo 'tri la plage des colonne A à K par rapport à la colonne A
For I = 3 To DL 'boucle sur toutes les ligne I de 3 a DL
    'définit la recherche R (recherche la valeur exacte de la cellule ligne I colonne 1 de l'onglet destination dans la colonne 12 de l'onglet source OS)
    Set R = OS.Columns(12).Find(OD.Cells(I, 1).Value, , xlValues, xlWhole)
    'si il existe au moins une occurrence trouvée, copie la cellule de l'occurrence trouvée redimensionnée à 11 colonnes dans la cellule ligne I colonne L de l'onglet destination OD
    If Not R Is Nothing Then R.Resize(1, 11).Copy OD.Cells(I, "L"): Set R = Nothing
Next I 'prochaine ligne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

ThauThème · Answer

Dans ton fichier, rajoute un onglet vierge nommé Feuil2 , puis lance le code ci-dessous. Le résultat en Feuil2 . Sub Macro1() Dim OS As Worksheet 'déclare la variable OS (Onglet Source) Dim OD As Worksheet 'déclare la variable OS (Onglet Destination) Dim DL As Integer 'déclare la variable DL (Derniere ligne) Dim I As Integer 'déclare la variable I (Incrément) Dim R As Range 'déclare la variable R (Recherche) Application.ScreenUpdating = False 'masque les rafraîchissements d'écran Set OS = Worksheets("Feuil1") 'définit l'onglet source OS Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD OD.Cells.Clear 'efface le contenu de l'onglet destination OD OS.Rows(1).Copy 'copie la première ligne de l'onglet source OD.Range("A1").PasteSpecial (xlPasteColumnWidths) 'colle la largeur OS.Rows(1 &amp; ":" &amp; 2).Copy OD.Range("A1") 'copie les deux premières ligne de l'ongelt source et les colle dans A1 de l'onglet destination DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la derniere ligne éditée DL de la colonne A de l'onglet source OS.Range("A3:K" &amp; DL).Copy OD.Range("A3") 'copie la partie gauche du tableau et la colle dans A3 de l'onglet source For I = 3 To DL 'boucle sur toutes les ligne I de 3 a DL 'définit la recherche R (recherche la valeur exacte de la cellule ligne I colonne 1 dans la colonne 12 de l'onglet source OS) Set R = OS.Columns(12).Find(OS.Cells(I, 1).Value, , xlValues, xlWhole) 'si il existe au moint une occurrence trouvée, copie la cellule de l'occurrence trouvée redimensionnée à 11 colonne dans la cellule ligne I colonne L de l'onglet destination OD If Not R Is Nothing Then R.Resize(1, 11).Copy OD.Cells(I, "L"): Set R = Nothing Next I 'prochaine ligne de la boucle Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran End Sub...