Microsoft 365 "concatener" certaines colonnes d'onglets

rastafouette · 9 Septembre 2024

Bonjour à tous,

Je bug un peu sur un traitement de tableau. Je vais essayer d'être claire.
Mon fichier de départ ne contient que l'onglet "Vierge" (évidemment bcp plus conséquent en vrai).
Chaque client (RIRI, FIFI, LOULOU etc...) reçoit ce fichier vierge, le remplit, parfois à la main sur papier, et me le renvoie.
Mon but final est d'avoir :
- un onglet par client (soit je recupère l'onglet excel en direct, soit je recopie moi-même ce que j'ai reçu de manuscrit), ça vous n'y pouvez pas grand chose
- un onglet TOTAUX qui fait l'addition des données de tous les clients (ça peut aller d'un fichier à 3 clients, donc 3 onglets, jusqu'à x)
- et SURTOUT des onglets par MOIS (janvier etc=> decembre), où je retrouve les données des clients, pour chacun de ces mois, dans les colonnes.(3 clients ou 18, ou 7, ou 42,... je ne sais pas cb je vais en récupérer) ==> par ex : l'onglet avril récapitule toutes les colonnes avril de tous les clients, qu'il y en ait 3 ou 42
Sachant que les lignes de produits, elles, sont fixes.

Je ne sais pas quelle fonction utiliser où s'il peut y avoir une macro facilement adaptable pour faire ça.

J'ai joint un fichier qui donne une idée du truc.

Merci

Bonne soirée

chris · 9 Septembre 2024

Bonjour
Il faut stocker les fichiers de tes clients dans un même dossier et les complier via POwerQuery et un TCD qui te donne tout :
le détail par produit et client, le total par produit et le total par mois

Modifier le chemin du dossier ou seront stockés les fichiers de chaque client avec chacun son onglet
exemple FIFI

Puis actualiser le TCD

rastafouette · 10 Septembre 2024

Bonjour,
Merci pour ta réponse. J'avais pensé aux TCD, mais l'inconvénient principal est que ce n'est pas moi qui gère le fichier ensuite et il faut tout dans le même fichier (l'onglet original vide, les copies remplies avec les données des clients, et quand ces données-là sont fixées, une douzaine d'onglets avec les mois et les recaps des clients dessus).
Et un tableau comme ça, avec 12 mois, X clients et une cinquantaine de produits, ça sera compliqué à gérer pour mes collègues qui ne sont pas très amis avec excel.

A la limite, un fichier avec les onglets des clients et un autre avec le découpage en mois. Mais pas sûre.
Il faudrait que si un client change sa commande ou s'il y en a un nouveau dans l'année, il suffise d'une seule manip pour mettre à jour les onglets des mois. Que la moulinette sache reconnaitre les onglets client et fasse les recap par mois.

Il faut que j'arrive à faire qqch de complet pour leur suivi tout en étant ultra simple visuellement avec le moins de manip de leurs coté pour éviter les coquilles et erreurs de formules.

Je ne sais pas si je suis très claire dans mes demandes, car les virus se sont tous donné rdv chez moi et j'ai les neurones un peu dans le gaz.

Merci

chris · 10 Septembre 2024

Bonjour

Rien n’empêche de faire un TCD par client.

Mais un TCD est filtrable d'un clic par produit/client/mois et personne ne regarde simultanément 50 onglets...

Et là, toute modif ou ajout dans un classeur du dossier clients est prise en compte lors de l'actualisation du TCD...

Quand à copier/coller les données de n classeurs clients c'est un non sens...

job75 · 12 Septembre 2024

Bonjour rastafouette, chris, le forum,

Voyez le fichier joint, la fonction VBA et les 4 macros affectées aux boutons :

VB:

Function TotalProduits(produit$, x)
Dim w As Worksheet, col%
Application.Volatile
If IsDate(x) Then
    x = CLng(x)
    For Each w In Worksheets
        If w.Name <> "Totaux" And Not IsDate("1/" & w.Name) Then
            col = Application.Match(x, w.Rows(3), 0)
            TotalProduits = TotalProduits + Application.VLookup(produit, w.Columns(1).Resize(, col), col, 0)
        End If
    Next
Else
    Set w = Sheets(CStr(x))
    x = CLng(Application.Caller.Parent.[B1])
    col = Application.Match(x, w.Rows(3), 0)
    TotalProduits = Application.VLookup(produit, w.Columns(1).Resize(, col), col, 0)
End If
End Function

Sub AjouterMois()
Dim x$, w As Worksheet, col%
x = Sheets(Sheets.Count).Name
If Not IsDate("1/" & x) Then MsgBox "La dernière feuille doit être un mois !", vbCritical: Exit Sub
x = Application.Proper(Format(CDate("1/" & x) + 31, "mmmm yyyy"))
If MsgBox("Voulez-vous créer le mois " & x & " ?", vbYesNo, "Ajouter Mois") = vbNo Then Exit Sub
Application.ScreenUpdating = False
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = x
ActiveSheet.[B1] = CDate("1/" & x)
For Each w In Worksheets
    If Not IsDate("1/" & w.Name) Then
        col = w.Cells(3, w.Columns.Count).End(xlToLeft).Column + 1
        If col > 3 Then
            w.Columns(col).Insert
            w.Columns(col - 1).Copy w.Columns(col)
            On Error Resume Next 'si aucune SpecialCell
            w.Columns(col).SpecialCells(xlCellTypeConstants).ClearContents
            w.Cells(3, col) = CDate("1/" & x)
        End If
    End If
Next w
End Sub

Sub AjouterNom()
Dim x As Variant, w As Worksheet, col%
Do
    x = Application.InputBox("Entrez le nom :", "Ajouter Nom", CStr(x))
    If x = "" Or x = False Then Exit Sub
    x = UCase(x)
    On Error Resume Next
    Set w = Sheets(UCase(x))
    On Error GoTo 0
    If w Is Nothing Then
        Application.ScreenUpdating = False
        Sheets("VIERGE").Copy Before:=Sheets("Totaux")
        ActiveSheet.Name = x
        ActiveSheet.DrawingObjects.Delete
        ActiveSheet.[B1] = x
        For Each w In Worksheets
            If IsDate("1/" & w.Name) Then
                col = w.Cells(3, w.Columns.Count).End(xlToLeft).Column + 1
                If col > 3 Then
                    w.Columns(col).Insert
                    w.Columns(col - 1).Copy w.Columns(col)
                    w.Cells(3, col) = x
                End If
            End If
        Next w
        Exit Sub
    Else
        MsgBox "Le nom " & x & " existe déjà", vbCritical
    End If
Loop
End Sub

Sub SupprimerMois()
Dim x$, w As Worksheet, col%
x = Sheets(Sheets.Count).Name
If Not IsDate("1/" & x) Then MsgBox "La dernière feuille doit être un mois !", vbCritical: Exit Sub
If MsgBox("Voulez-vous supprimer le mois " & x & " ?", vbYesNo, "Supprimer Mois") = vbNo Then Exit Sub
Application.DisplayAlerts = False
Sheets(x).Delete
For Each w In Worksheets
    For col = w.Cells(3, w.Columns.Count).End(xlToLeft).Column To 4 Step -1
        If w.Cells(3, col) = CDate("1/" & x) Then w.Columns(col).Delete
Next col, w
End Sub

Sub SupprimerNom()
Dim x As Variant, w As Worksheet, col%
x = Application.InputBox("Entrez le nom à supprimer :", "Supprimer Nom")
If x = "" Or x = False Then Exit Sub
x = UCase(x)
If x = "VIERGE" Or x = "TOTAUX" Or IsDate("1/" & x) Then Exit Sub
On Error Resume Next
Set w = Sheets(x)
On Error GoTo 0
If w Is Nothing Then Exit Sub
Application.DisplayAlerts = False
w.Delete
For Each w In Worksheets
    For col = w.Cells(3, w.Columns.Count).End(xlToLeft).Column To 4 Step -1
        If w.Cells(3, col) = UCase(x) Then w.Columns(col).Delete
Next col, w
End Sub

En cliquant sur un bouton on ajoute ou supprime le dernier mois ou un nom.

Je pense qu'il n'y a pas besoin d'autre chose.

A+

job75 · Vendredi à 09:33

Bonjour le forum,

job75 à dit:
Je pense qu'il n'y a pas besoin d'autre chose.

Si, il faut ajouter cette macro :

VB:

Sub DerniereFeuille()
Dim w As Worksheet, x$, datmax As Date, ac As Object
For Each w In Worksheets
    x = "1/" & w.Name
    If IsDate(x) Then If CDate(x) > datmax Then datmax = CDate(x)
Next w
If datmax = 0 Then MsgBox "Vous devez créer au moine une feuille mois !", vbCritical: End
Set w = Sheets(Format(datmax, "mmmm yyyy"))
If w.Name = Sheets(Sheets.Count).Name Then Exit Sub
Set ac = ActiveSheet
w.Move After:=Sheets(Sheets.Count)
ac.Activate
End Sub

Si l'utilisateur l'a déplacée la macro remet la feuille du dernier mois en dernière position.

Par ailleurs, les fonctions TotalProduit étant volatiles elles se recalculent à l'ouverture du fichier.

Pour éviter l'invite à la fermeture on peut mettre ce code dans ThisWorkbook :

VB:

Private Sub Workbook_Open()
Me.Saved = True 'évite l'invite à la fermeture si aucune modification
End Sub

A+

rastafouette · Vendredi à 20:46

Bonsoir à tous

Pardon de ma réponse tardive, je n'ai pas eu bcp de temps pour me repencher sur ce projet.

Chris, merci de ta proposition, j'ai à peu près réussi en jouant avec les TCD sur mes tableaux originaux mais les TCD vont faire peur à mes collègues et je n'ai pas la main sur tout.

Job, merci beaucoup de tes macros, ça correspond bcp mieux à mes besoins. Il y a qques détails que je ne saisis pas trop dans les macros, mais je vais m'y pencher ce week-end et réfléchir dessus en l'adaptant à mes fichiers.

Merci encore et bonne soirée

job75 · Vendredi à 21:56

N'hésitez pas à poser des questions sur ce que vous ne comprenez pas.

job75 · Samedi à 09:14

Bonjour rastafouette, le forum,

Eh non ce n'était pas fini.

Pour tester j'ai recopié tous les tableaux sur 5000 lignes avec 5000 produits différents.

Le recalcul des formules se fait chez moi en 15 secondes, c'est pénible surtout que cela se produit dès qu'on modifie une cellule dans les feuilles FIFI, RIRI, LOULOU.

Pour y remédier il faut supprimer Application.Volatile dans la fonction TotalProduit.

Cependant pour forcer le recalcul j'ai mis dans ThisWorkbook :

VB:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim x$
x = UCase(Sh.Name)
If x = "TOTAUX" Or IsDate("1/" & x) Then Sh.Rows(3).Copy Sh.Rows(3) 'force le recalcul des formulrs
End Sub

qui donne les résultats suivants avec 5000 produits :

- activation de la feuille "Totaux" => 5 secondes

- activation des feuilles mois => 1 seconde.

C'est quand même mieux.

A+

job75 · Dimanche à 07:37

Bonjour rastafouette, le forum,

Encore quelques améliorations dans le fichier précédent :

1) j'ai ajouté un test de sécurité aux macros "SupprimerMois" et "SupprimerNom"

2) dans les feuilles j'ai revu les formules utilisant DECALER

3) j'ai revu la fonction "TotalProduits" pour aller plus vite :

VB:

Function TotalProduits(produit$, x)
Dim i%, w As Worksheet, col%
If IsDate(x) Then
    x = CLng(x)
    For i = Sheets("VIERGE").Index + 1 To Sheets("Totaux").Index - 1
        Set w = Sheets(i)
        col = Application.Match(x, w.Rows(3), 0)
        TotalProduits = TotalProduits + Application.VLookup(produit, w.Cells, col, 0)
    Next
Else
    Set w = Sheets(CStr(x))
    x = CLng(Application.Caller.Parent.Range("B1"))
    col = Application.Match(x, w.Rows(3), 0)
    TotalProduits = Application.VLookup(produit, w.Cells, col, 0)
End If
End Function

Avec 5000 produits la feuille "Totaux" s'active maintenant en 2,9 secondes.

A+

rastafouette · Mardi à 13:18

Bonjour,

Merci ENORMEMENT !!
Ca marche vraiment bien et j'ai réussi à l'adapter à mon fichier. Je continue de travailler dessus et maintenant j'ai même encore d'autres idées d'amélioration , ça n'en finit jamais !

Bon après-midi

rastafouette · Mardi à 20:40

Bonsoir,
J'ai une petite question à 10cts pour ce soir.
J'ai changé le format des Sheet.Name en "mm-yy" au lieu de "mmm yy" dans AjouterMois et DerniereFeuille.
Puis j'ai changé SupprimerMois avec une inputbox, comme pour SupprimerNom :

VB:

''        Sub SupprimerMois()
''        Dim x$, w As Worksheet, col%
''        DerniereFeuille
''        x = Sheets(Sheets.Count).Name
''        If MsgBox("Voulez-vous supprimer le mois " & x & " ?", vbYesNo, "Supprimer Mois") = vbNo Then Exit Sub
''        If UCase(Sheets(Sheets(x).Index - 1).Name) = "TOTAUX" Then MsgBox "Il ne reste qu'un mois !", vbCritical: Exit Sub
''        Application.DisplayAlerts = False
''        Sheets(x).Delete
''        For Each w In Worksheets
''            For col = w.Cells(4, w.Columns.Count).End(xlToLeft).Column To 4 Step -1
''                If w.Cells(4, col) = CDate("1/" & x) Then w.Columns(col).Delete
''        Next col, w
''        End Sub

Sub SupprimerMois()
        Dim x As Variant, w As Worksheet, col%
        DerniereFeuille
        x = Application.InputBox("Entrez le MOIS à supprimer :", "Supprimer MOIS")

        If x = "" Or x = False Then Exit Sub
        If UCase(Sheets(Sheets(x).Index - 1).Name) = "TOTAUX" Then MsgBox "Il ne reste qu'un mois !", vbCritical: Exit Sub

        Application.DisplayAlerts = False
        Sheets(x).Delete
        For Each w In Worksheets
            For col = w.Cells(4, w.Columns.Count).End(xlToLeft).Column To 4 Step -1
                If w.Cells(4, col) = CDate("1/" & x) Then w.Columns(col).Delete
        Next col, w
        End Sub

Donc, j'arrive à supprimer un mois intermédiaire et non plus forcément le dernier en mettant bien le bon format dans l'inputbox.
Ma question est donc, comment je peux border et sécuriser l'inputbox et les formats pour que, si un collègue y met "nov 2024" au lieu de "11-24", ça propose quand même confirmation du bon mois et que ça supprime le bon mois.

(Bon, j'ai adapté la sub originelle SupprimerMois, mais s'il y a mieux et plus propre, je prends aussi )

Bonne soirée à tous

job75 · Hier à 16:16

Bonjour rastafouette,

Vous pouvez utiliser cette macro :

VB:

Sub SupprimerMois()
Dim x As Variant, dat&, w As Worksheet, col%
If UCase(Sheets(Sheets.Count - 1).Name) = "TOTAUX" Then MsgBox "Il ne reste qu'un mois !", vbCritical: Exit Sub
Application.DisplayAlerts = False
Do
    x = Application.InputBox("Entrez le mois à supprimer :", "Supprimer Mois", CStr(x))
    If x = "" Or x = False Then Exit Sub
    On Error Resume Next
    If IsDate("1-" & x) Then dat = CLng(CDate("1-" & x)): Sheets(Format(dat, "mm-yy")).Delete
    If Err Then MsgBox "Ce mois n'existe pas !"
Loop While Not IsDate("1-" & x) Or Err
For Each w In Worksheets
    For col = w.Cells(3, w.Columns.Count).End(xlToLeft).Column To 3 Step -1
        If w.Cells(3, col) = dat Then w.Columns(col).Delete
Next col, w
End Sub

A+

Microsoft 365 "concatener" certaines colonnes d'onglets

rastafouette

XLDnaute Occasionnel

Pièces jointes

chris

XLDnaute Barbatruc

Pièces jointes

rastafouette

XLDnaute Occasionnel

chris

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

rastafouette

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

rastafouette

XLDnaute Occasionnel

rastafouette

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Discussions similaires