Consolider 2 feuils Excel en une Synthèse

Bonjour,
Je souhaite consolider deux feuils en une synthèse. Les deux feuils comportent un tableau avec un titre plus au moins changeant, car j'y affiche les données par mois (Février, Mars, Avril, Mai et Juin).
Je consolide les deux feuil via la macro que j'ai trouvé sur le net et personnalisé pour mon besoin.

Sub consolider()
Dim ws As Worksheet

For Each ws In Worksheets
If ws.Name <> "TYPTRA" Then
ws.Range(ws.Range("A1"), _
ws.Range("A1").SpecialCells(xlCellTypeLastCell)).Copy _
Destination:=Worksheets("TYPTRA").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next
End Sub

le souci qui se pose, c'est qu'au lieu d'obtenir un tableau à côté de l'autre comme ce que j'obtiens lorsque je passe pas la fonction "consolider" d'Excel, j'ai un tableau en dessous de l'autre, et je ne sais pas trop, comment vais-je corriger cela.

Autre souci, je veux lors de la consolidation, supprimer la colonne où j'ai des "N/A".

pouvez-vous m'aider dessus svp.

par avance merci.

Aub.

Bonjour

As-tu la possibilité d'installer l'add on PowerQuery (intégré à Excel à partir de 2016) ?

malheureusement non.

Il faut que je la fasse en vba, car les autres utilisateurs, n'ont pas la possibilité de passer via Power Query, mais lors de la consolidation, le tableau de la feuille 2, se met en dessous du tableau 1, alors qu'il faut qu'il soit à côté afin de former 1 seul tableau.

Bonjour,

Une proposition à étudier.

ALT F8 puis exécuter la procédure ou Ctrl + m

Cdlt.

Option Explicit

Public Sub Consolidate_Data()
Dim ws As Worksheet, lo As ListObject
Dim tbl, arr()
Dim r As Range
Dim I As Long, J As Long, k As Long

    Set lo = Range("Consolidation").ListObject

    With lo
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set r = .InsertRowRange.Cells(1)
    End With

    For Each ws In ActiveWorkbook.Worksheets
        Select Case ws.Name
            Case "Consolidation", "TCD":
            Case Else:
                tbl = ws.Cells(1).CurrentRegion.Value
                For I = 2 To UBound(tbl)
                    For J = 3 To 5
                        If tbl(I, J) <> "" Then
                            ReDim Preserve arr(6, k + 1)
                            arr(0, k) = tbl(I, 1)                               'Référence
                            arr(1, k) = Format(CLng(tbl(1, J)), "yyyy-mm")      'Année mois
                            arr(2, k) = tbl(I, 6)                               'Libellé
                            arr(3, k) = tbl(I, 7)                               'Commentaire
                            arr(4, k) = tbl(I, 8)                               'RefType
                            arr(5, k) = tbl(I, J)                               'Valeur
                            k = k + 1
                        End If
                    Next J
                Next I
        End Select
    Next ws

    If k > 0 Then r.Resize(k, 7).Value = Application.Transpose(arr)

    lo.HeaderRowRange.EntireColumn.AutoFit

    Worksheets("TCD").PivotTables(1).PivotCache.Refresh

End Sub

Merci Jean-Eric, mais malheureusement, je n'ai pas su adapter ton code à mon besoin.

J'ai l'erreur d’exécution 1004, et je ne sais pas trop par où commencer pour la corriger.

Et après un autre test, j'obtiens le code d'erreur 400.

Re,

C'est ballot, j'ai omis de joindre le fichier.

Super, merci beaucoup Jean-Eric