Fusionner 2 colonnes de données

Bonjour,

Alors, voilà le problème :

J'ai 2 colonnes de noms avec une valeur en euros à coté de chaque colonne. Ce qui me fait donc 4 colonnes.

Les deux colonnes de noms possèdent des noms similaires et des différents.

Ce que je voudrais réaliser c'est : fusionner les 2 colonnes de noms en 1 seules mais que les chiffres restent en face de leur noms en deux colonnes.

Donc au final, j'ai les noms des deux colonnes en une sans doublons. Et à côté, deux colonnes de chiffres situés en face des noms qui correspondent. Je pourrai ainsi totaliser les deux colonnes de chiffres par personnes pour les 2 mois.

Merci d'avance

Aurélien

Bonsoir,

ici, résultats avec le total des 2 tableaux

Amicalement

Claude

Bonjour,

Ci-joint ma proposition de solution.

J'espère qu'elle te conviendra.

Bonsoir,

Comme j'ai quand même cherché, je te présente un code bien plus amateur que celui de Claude, mais qui répond à cette demande

Aramirdar a écrit :

Et à côté, deux colonnes de chiffres situés en face des noms qui correspondent

Bonne soirée

re,

Variante avec résultats sur 2 colonnes

Sub Tablo2Colonnes()
Dim Lg%, Lg2%, i%, x%, cL%, A As Byte
'Macro par Claude Dubois pour "Aramirdar" Excel-Pratique le 14/10/10
    Application.ScreenUpdating = False
    '---- prépare ----
    Range("i:k").EntireColumn.Clear
    Range("d2,i2") = "résultat"
        Lg = Range("b65536").End(xlUp).Row
    Range("b3:b" & Lg).Copy Destination:=Range("d3")

        Lg2 = Range("d65536").End(xlUp).Row
    Range("f3:f" & Lg2).Copy Destination:=Range("d65536").End(xlUp)(2)
        Lg = Range("d65536").End(xlUp).Row

    Range("d2:d" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("o1:o2"), CopyToRange:=Range("i2"), Unique:=True
    Range("d2:d" & Lg).Clear

    '---- valeurs ----
    Lg = Range("i65536").End(xlUp).Row
    Range("b3:b4").Copy
    Range("i3:k" & Lg).PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
        cL = 10
    For A = 2 To 6 Step 4
        For i = 3 To Lg
            On Error Resume Next
            x = WorksheetFunction.Match(Cells(i, 9), Columns(A), 0)
            On Error GoTo 0
            If x > 0 Then
                Cells(i, cL) = Cells(i, cL) + Cells(x, A + 1)
                x = 0
            End If
        Next i
        cL = cL + 1
    Next A
        Application.Goto Range("a1"), Scroll:=True
End Sub

Amicalement

Claude

Super, c'est exactement ce que je voulais! Merci beaucoup à vous ! Cela ira bien plus vite maintenant!

Au boulot 8)

Bonjour à tous,

Juste pour le fun, macro simplifiée avec choix du format résultat.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lg%, i%, x%, cL%
If Not Application.Intersect(Target, Range("e1")) Is Nothing Then
    Application.ScreenUpdating = False
    Lg = Cells.Find("*", , , , xlByRows, xlPrevious).Row
    Range("i2:k" & Lg).Clear
    Range("b3:c" & Lg).Copy Destination:=Range("i3")
    '---- ajoute dans liste si manque ----
        For i = 3 To Lg: x = 0
            On Error Resume Next
            x = WorksheetFunction.Match(Cells(i, 6), Columns(9), 0)
            On Error GoTo 0
            If x = 0 Then Cells(65000, 9).End(xlUp)(2) = Cells(i, 6)
        Next i
    '---- formate ----
            cL = 11 'colonne valeurs
            If Target = "Total" Then cL = 10: Cells(2, 10) = "Total"
        Lg = Range("i65536").End(xlUp).Row
            Range("i3:i4").Copy ' format
            Range(Cells(3, 9), Cells(Lg, cL)).PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
    '---- valeurs ----
        For i = 3 To Lg: x = 0
            On Error Resume Next
            x = WorksheetFunction.Match(Cells(i, 9), Columns(6), 0)
            On Error GoTo 0
            If x > 0 Then Cells(i, cL) = Cells(i, cL) + Cells(x, 7)
        Next i
    Application.Goto Range("a1"), Scroll:=True: Target.Activate
End If
End Sub

Amicalement

Claude

Trop fort! Merci encore à toi!