Macro pour créer un fichier récapitulatif

Audeo a écrit :

J'ai recrée le fichier...

21exemplecommandes.xls (24.50 Ko)

Ce qui m'étonne dans cet exemple c'est le vide en G4 et A9. Tu peux donc aussi faire comme ceci pour éviter les donnés sans en-tête

Option Explicit

Sub recap()
Dim fichier, tbl, i, j, wbk As Workbook, ligne, f As Worksheet, dico As Object, cle, nbl, nbc

    Set dico = CreateObject("Scripting.Dictionary")

    Application.DisplayAlerts = False
    For Each f In Worksheets
        If f.Name <> "compil" Then f.Delete
    Next
    Application.DisplayAlerts = True

    ' collecte les données du fichier source dans un tableau
    fichier = Application.GetOpenFilename("fichier excel (*.xls), *.xls", , "Sélection de vos fichiers excel", , False)
    If fichier = False Then Exit Sub
    Set wbk = Workbooks.Open(fichier)
        nbc = Range("A4").End(xlToRight).Column
        nbl = Range("A4").End(xlDown).Row - 3
        tbl = Range("A4").Resize(nbl, nbc)
    wbk.Close

    ' crée les onglets
    For j = 2 To UBound(tbl, 2)
        dico(Left(tbl(1, j), 20)) = ""
    Next
    For Each cle In dico.keys
        With ThisWorkbook
            .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = cle
        End With
        Sheets(cle).Cells(1, 1) = "PRODUIT"
        Sheets(cle).Cells(1, 2) = "QUANTITE"
    Next

    ' traite le tableau
    For i = 2 To UBound(tbl)
        For j = 2 To UBound(tbl, 2)
            If tbl(i, j) <> "" And tbl(i, j) <> 0 Then
                ligne = Sheets(Left(tbl(1, j), 20)).Cells(Rows.Count, 1).End(xlUp).Row + 1
                Sheets(Left(tbl(1, j), 20)).Cells(ligne, 1) = tbl(i, 1)
                Sheets(Left(tbl(1, j), 20)).Cells(ligne, 2) = tbl(i, j)
            End If
        Next
    Next

End Sub

S'il fallait aller plus loin, si un jour ton fichier de base évoluait, il faudrait alors passer à une version où tu sélectionnes la plage à prendre en compte, y compris en-tête du tableau pour avoir les clients, mais en dehors des totaux.

Merci, cela fonctionne impeccable. Génial

Juste la cerise sur le gâteau : est-il possible de rajouter le nom complet du client en 1ere ligne au dessus de PRODUIT et QUANTITE dans chaque onglet tronqué.

Histoire de présenter une future mise en page de facture... c'est jouable sans tout casser ?

Ah ok, tu veux dire que si plus tard, on rajoute de nouveaux produits en ligne ou de nouveaux client en colonne, cela risque de poser problème ?

Comment fait-on un autofit des cellules après remplissage/affichage du tableau ?

je te fais cela demain avant 6h

Audeo a écrit :

Comment fait-on un autofit des cellules après remplissage/affichage du tableau ?

fais une macro par apprentissage, c'est parfois le moyen le plus rapide d'avoir le code :

Cells.EntireColumn.AutoFit

Audeo a écrit :

Juste la cerise sur le gâteau : est-il possible de rajouter le nom complet du client en 1ere ligne au dessus de PRODUIT et QUANTITE dans chaque onglet tronqué.

essaie comme ceci (pas testé)

Option Explicit

Sub recap()
Dim fichier, tbl, i, j, wbk As Workbook, ligne, f As Worksheet, dico As Object, cle, nbl, nbc

    Set dico = CreateObject("Scripting.Dictionary")

    Application.DisplayAlerts = False
    For Each f In Worksheets
        If f.Name <> "compil" Then f.Delete
    Next
    Application.DisplayAlerts = True

    ' collecte les données du fichier source dans un tableau
    fichier = Application.GetOpenFilename("fichier excel (*.xls), *.xls", , "Sélection de vos fichiers excel", , False)
    If fichier = False Then Exit Sub
    Set wbk = Workbooks.Open(fichier)
        nbc = Range("A4").End(xlToRight).Column
        nbl = Range("A4").End(xlDown).Row - 3
        tbl = Range("A4").Resize(nbl, nbc)
    wbk.Close

    ' crée les onglets
    For j = 2 To UBound(tbl, 2)
        dico(Left(tbl(1, j), 20)) = ""
    Next
    For Each cle In dico.keys
        With ThisWorkbook
            .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = cle
        End With
        Sheets(cle).Cells(2, 1) = "PRODUIT"
        Sheets(cle).Cells(2, 2) = "QUANTITE"
    Next

    ' traite le tableau
    For j = 2 To UBound(tbl, 2)
        Sheets(Left(tbl(1, j), 20)).Cells(1, 1) = tbl(i, j)
        For i = 2 To UBound(tbl)
            If tbl(i, j) <> "" And tbl(i, j) <> 0 Then
                ligne = Sheets(Left(tbl(1, j), 20)).Cells(Rows.Count, 1).End(xlUp).Row + 1
                Sheets(Left(tbl(1, j), 20)).Cells(ligne, 1) = tbl(i, 1)
                Sheets(Left(tbl(1, j), 20)).Cells(ligne, 2) = tbl(i, j)
            End If
        Next
    Next

End Sub

Merci de ton aide Steelson.

J'ai testé cela ne change rien...

Tip top

c'est exactement ça, impeccable.

Grand merci à toi Steelson pour ton aide.