Importer des colonnes de plusieurs feuilles sur une feuille

Bonjour,

Je souhaiterais réaliser une macro qui importe et concaténer des colonnes (même donnée) de plusieurs feuilles et les mettre sur une feuille.

Le fichier ci-joint explique mieux mon besoin

Je vous remercie par avance pour votre aide

Cordialement,

44fichiertest.xlsx (12.52 Ko)

Bonjour,

Une proposition à étudier.

Cdlt.

33fichiertest.xlsm (33.35 Ko)
Option Explicit

Private Sub cmdConsolidate_Click()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim rCell As Range

    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    Set ws2 = wb.Worksheets("Feuil3")
    Set lo2 = ws2.ListObjects(1)
    '------------------------------------------------------------------------------
    With lo2
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set rCell = .InsertRowRange.Cells(1)
    End With
    '------------------------------------------------------------------------------
    For Each ws In wb.Worksheets
        If ws.Name <> ws2.Name Then
            Set lo = ws.ListObjects(1)
            With lo
                .ListColumns("Produit").DataBodyRange.Copy
                rCell.PasteSpecial xlPasteValues
                .ListColumns("Qté").DataBodyRange.Copy
                rCell.Offset(0, 1).PasteSpecial xlPasteValues
                .ListColumns("prix").DataBodyRange.Copy
                rCell.Offset(0, 2).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                Set rCell = lo2.HeaderRowRange.Cells(1).Offset(lo2.ListRows.Count + 1)
            End With
        End If
    Next ws
    '------------------------------------------------------------------------------
    Set rCell = Nothing
    Set lo = Nothing: Set lo2 = Nothing
    Set ws2 = Nothing
    Set wb = Nothing

End Sub

Bonjour Jean-Eric,

Merci pour votre proposition. Malheureusement, ca marche pas pour moi car je peux avoir des sources de données avec des appellations différentes (Price/ Prix..) y a t il un moyen de jouer sur l'index de la colonne à concaténer au lieu de l'entête?

Merci encore pour votre aide

Re,

Tu ne pouvais pas envoyer un fichier représentatif ?

Et d'où proviennent tes sources de données ?

Tu sais ce que tu dois faire pour une aide complémentaire.

Cdlt.

Hello,

Voici l'exemple dont je t'ai parlé, j'ai pas les memes entêtes en fait

25fichiertest.xlsx (12.72 Ko)

Bonjour,

Voir le fichier modifié en conséquence.

Cdlt.

36fichiertest-v2.xlsm (33.76 Ko)

Bonjour Jean-Eric,

Un grand merci pour ton code, mais ça marche toujours pas

En fait, dans ton fichier la macro fonctionne parfaitement mais quand je change la dimension des tableaux pour les adapter à mon besoin, ça m'afficher erreur "9", "l'indice n'appartient pas à la sélection"

Pourrais-tu me dire si t'as une idée sur ce type d'erreur?

Merci!

Bonjour,

As-tu mis tes données sous forme de tableaux ?

Cdlt.

Bonjour Jean-Eric,

Je te transmets ci-joint mon exemple, il me semble que oui c'est sous format de tableau.

J'ai aussi modifié le code en fonction de mon besoin

Dans l'attente de ton retour je te remercie encore une fois!

21fichiertest-v3.xlsm (49.23 Ko)

Bonjour,

J'ai mis tes données sous forme de tableau (Ruban / Accueil / Mettre sous forme de tableau), supprimer les cellules fusionnées, etc...

A te relire.

Cdlt.

43fichiertest-v3.xlsm (37.75 Ko)

Super merci Jean-Eric !! cela fonctionne parfaitement!

Par ailleurs, si je demande pas trop ^^ pour le changement de format de tableau et annulation des cellules fusionnées, y a t il un moyen de la faire dans la macro?

Encore une fois merci!!

Bonjour,

Un exemple à adapter.

Faire attention aux noms des feuilles !?

Option Explicit

Public Sub CreateTables()
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject
Dim ACell As Range
    Application.ScreenUpdating = False
    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        With ws
            Set ACell = .Cells(6, 1)
            If ACell.ListObject Is Nothing And ACell.Value <> "" Then
                With ACell
                    .CurrentRegion.UnMerge
                    Set lo = ws.ListObjects.Add _
                             (xlSrcRange, .CurrentRegion, , xlYes)
                    With lo
                        .DisplayName = "tbl_" & ws.Name
                        .TableStyle = "TableStyleMedium2"
                    End With
                End With
            End If
        End With
    Next ws
    Set ACell = Nothing: Set lo = Nothing: Set wb = Nothing
End Sub
Rechercher des sujets similaires à "importer colonnes feuilles feuille"