Fusion de plusieurs tableaux avec plusieurs colonnes texte dont une commune à tous

[macno]

Bonjour,

Je dois fusionner plusieurs tableaux qui sont présents sur des feuilles différentes :
- un avec plusieurs colonnes de texte et plusieurs colonnes contenant des chiffres
- Plusieurs autres avec une colonne de texte et plusieurs colonnes de chiffres

Ils ont tous en commun une colonne avec la même étiquette et des textes parfois identiques et parfois pas.

Je souhaite avoir au final un TCD avec toutes les colonnes sur une feuille différente (en pièce jointe).

Avec une plage de feuille de calcul avec étiquette, j'ai bien ma colonne de texte commune et les colonnes de chiffre, mais je ne peux pas conserver mes autres colonnes de texte.

Auriez-vous des idées ?
Merci d'avance pour votre aide

Ludovic

 

[macno]

Re : Fusion de plusieurs tableaux avec plusieurs colonnes texte dont une commune à to

J'ai essayé d'écrire un bout de code qui fait les actions suivantes, mais ça marche pas : " Erreur de compilation " Next sans For"
A vrai dire les macros c'est aps trop ma partie, s'il y a un peu d'aide pour débugger ce code ou en proposer un qui corresponde au besoin, je suis preneur Merci d'avance.

- Sur la 1ere feuille "Source1", je trie la 1ere colonne "A" par ordre alphabétique
- Sur la 2eme feuille "Source2", je trie la première colonne "A" par ordre alphabétique
- Je copie les colonnes de la 1ere et 2eme feuille dans une 3eme "Résultat"
- Dans la 3eme, Je compare pour chaque ligne à partir de la 2eme, la cellule de la 1ere colonne "A" avec la cellule de l'autre colonne à comparer "D"
- Si c'est égal, je passe à la ligne suivante
- Si la valeur alphabétique de la cellule de la colonne "A" est plus petite que celle de la colonne "D", on coupe à partir de cette ligne une plage de cellules des colonnes D E F G H, jusqu'en bas et on la copie une ligne dessous. Puis on passe à la ligne suivante.
- Si la valeur de la cellule de la colonne "D" est plus petite que celle de la première colonne, on coupe la plage de cellules à partir de cette ligne sur les colonnes A b C jusqu'à la dernière ligne et on copie une ligne dessous. On copie la valeur de la cellule de la colonne "D" dans la cellule vide de la colonne "A". Puis on passe à la ligne suivante.
- On arrête quand on compare 2 cellules vides.

Le code correspondant qui ne marche pas :

Sub Tri_deplace_copie()
'
' Tri_deplace_copie Macro
'

Dim I As Integer
Dim J As Integer


'   tri sur les colonnes de source 1
    Sheets("Source1").Select
    Columns("A:C").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Source1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Source1").Sort.SortFields.Add Key:=Range("A2:A7") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Source1").Sort
        .SetRange Range("A1:C7")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'   tri sur les colonnes de source 2
    Sheets("Source2").Select
    Columns("A:E").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Source2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Source2").Sort.SortFields.Add Key:=Range("A2:A6") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Source2").Sort
        .SetRange Range("A1:E6")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'   Copie des colonnes des 2 feuilles dans 1 troisième
    Selection.Copy
    Sheets("Temp").Select
    Range("D1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Sheets("Source1").Select
    Selection.Copy
    Sheets("Temp").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
   
'   Initialise les compteurs
    J = 500
    I = 2
    
    With Sheets("Temp")
    For I = 2 To 300
 
         'Si c'est égal je passe à la ligne suivante
         If Range("A" & I).Value = Range("D" & I).Value Then
         I = I + 1
                 
        'Si D < A je coupe et colle une plage de cellule et copie la valeur de la cellule D en A
         If Range("A" & I).Value > Range("D" & I).Value Then
         Range("A" & I & ":C" & I & ",A" & J & ",C" & J).Cut Destination:=Range("A" & I + 1)
         Range("A" & I + 1) = Range("D" & I + 1).Value
         I = I + 1
                  
         'Si A < D je coupe et colle une autre plage de cellule
         If Range("A" & I).Value < Range("D" & I).Value Then
         Range("D" & I & ":G" & I & ",D" & J & ",G" & J).Cut Destination:=Range("D" & I + 1)
         I = I + 1
         End If
         
    Next
    End With
    
End Sub

 

[macno]

Re : Fusion de plusieurs tableaux avec plusieurs colonnes texte dont une commune à to

Avec la modif ci-dessous, j'ai maintenant une erreur "La commande ne peut pas être utilisée sur des sélections multiples" sur la ligne :
Range("A" & I & ":C" & I & ",A" & J & ",C" & J).Cut Destination:=Range("A" & I + 1)

 J = 500
    I = 2
    
    With Sheets("Temp")
    For I = 2 To 300
 
         'Si c'est égal je passe à la ligne suivante
         If Range("A" & I).Value = Range("D" & I).Value Then
         I = I + 1
         End If
                 
        'Si D < A je coupe et colle une plage de cellule et copie la valeur de la cellule D en A
         If Range("A" & I).Value > Range("D" & I).Value Then
         Range("A" & I & ":C" & I & ",A" & J & ",C" & J).Cut Destination:=Range("A" & I + 1)
         Range("A" & I + 1) = Range("D" & I + 1).Value
         I = I + 1
         End If
                  
         'Si A < D je coupe et colle une autre plage de cellule
         If Range("A" & I).Value < Range("D" & I).Value Then
         Range("D" & I & ":G" & I & ",D" & J & ",G" & J).Cut Destination:=Range("D" & I + 1)
         I = I + 1
        End If
    Next
    End With