XL 2016 Regrouper les données de six feuilles sur une seule

bhbh à dit:

Bonjour,
Avec Power Query
Pour mettre à jour, clic droit dans la requête, "Actualiser"
Bon appéti

Cliquez pour agrandir...

job75 à dit:

Bonjour luno123, lizzmo, bhbh,

Une question : dans la feuille "New" à quoi va servir la colonne B (vide) ?

Si après traitement vous y entrez manuellement des données (à conserver) le problème est compliqué.

A+

Cliquez pour agrandir...

job75 à dit:

@luno123 vous ne répondez pas à ma question.

Dans votre fichier il y a une colonne B vide entre la colonne A et la colonne CDT de la feuille "New".

Dans la solution de bhbh il n'y en a pas et de toute façon sur Power Query le tableau des résultats ne doit pas être modifié manuellement.

Voici une solution VBA qui permet l'entrée de données manuelles en colonne B et de les conserver :

VB:

Private Sub Worksheet_Activate()
Dim ncol%, d As Object, dd As Object, tablo, i&, x$, j%, resu(), n&
ncol = 8 'nombre de colonnes restituées
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    d(CStr(tablo(i, 1))) = tablo(i, 2) 'mémorise la colonne B
Next i
For j = 3 To ncol
    tablo = Sheets(CStr(Cells(1, j))).Cells(1).CurrentRegion.Resize(, 2) 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        x = CStr(tablo(i, 1))
        If Not dd.exists(x) Then
            n = n + 1
            dd(x) = n 'mémorise la ligne
            ReDim Preserve resu(1 To ncol, 1 To n)
            resu(1, n) = x
            resu(2, n) = d(x) 'récupère la colonne B mémorisée
        End If
        resu(j, dd(x)) = tablo(i, 2) 'récupère la ligne
Next i, j
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2]
    If n Then
        .Resize(n, ncol) = Application.Transpose(resu) 'Transpose est limitée à 65536 lignes
        .Resize(n, ncol).Sort .Cells, xlAscending, Header:=xlNo 'tri
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
    .Resize(, ncol).EntireColumn.AutoFit 'ajustement largeurs
End With
End Sub

La macro se déclenche automatiquement quand on active la feuille.

Elle est très rapide car elle utilise des tableaux vba et 2 Dictionary.

Nota : si plus de 65536 lignes doivent être restituées dites-le, il faudra un code pour transposer.

A+

Cliquez pour agrandir...