XL 2019 Ventilation des données selon nom dans colonne 1 = nom des onglets

[Dwindle]

Bonjour à tous,

Je suis novice en programmation VBA, mais j'ai de relativement bonnes connaissances sur EXCEL.

Je sais faire un enregistrement de macro mais je suis vite limitée.

J'espère que quelqu'un pourra éclairer ma lanterne sur le projet que j'aimerais mettre en place pour mon entreprise.

Voilà, j'ai un fichier avec un tableau comprenant la date du jour J, le nom de mes clients (client 1,2 etc) ainsi que le nombre des travaux de secrétariat effectués répartie en 5 colonnes (Normal, en 3h, en 6h, les modifications, et les dossiers/formalités - les prix étants différents).

J'ai créer des onglets qui représente les fiches clients où je souhaiterais tenir un historique des travaux effectués et de quels types, les jours où il y en a.

Je souhaiterais, à partir d'un bouton, transférer toutes les données de ma feuille 1 (Date, TS Normal, TS 3h, TS 6h, TS modif, TS Doss/form) en les répartissant sur les onglets clients correspondants (nom identique à nom client en colonne). Exemple : Travaux réalisés (sur 5 colonnes) pour le client 1 dans le l'onglet du client 1. Travaux réalisés (sur 5 colonnes) pour le client 3 dans l'onglet du client 3.

Je pensais faire des enregistrements macros en chaine pour chaque ligne de client (avec insertion d'une ligne, copier coller, effacer...) mais me voilà face à un problème :
si, un jour A, le client 2 ne m'a pas demandé de travaux, la ligne sera vide, et je ne veux pas qu'elle se "colle" dans son onglet (avec le jour A, et une ligne vide).

J'ai commencé à faire un bouton en fin de ligne pour chaque client, mais je trouve cela redondant.

Un peu comme un formulaire en somme, qui enverrait les données sur plusieurs onglets avec la date du jour.
A termes, j'aimerai également qu'il me servent d'historique de paiement pour chaque client qui paie au fur et à mesure et donc rajouter une autre cellule "paiement" qui se transfèrera dans l'onglet correspondant toujours avec la date du jour.

Avez-vous une méthode ? J'essaie d'apprendre alors n'hésitez pas à me détailler vos codes ou solutions ...

Je vous joins mon fichier.

Merci par avance pour vos retours,

Dwindle

 

[sousou]

bonjour

peux tu fournir un fichier avec des exemples concrets, afin de voir comment tu implémentes tes travaux

 

[Dwindle]

Bonjour,
Oui. Le voilà. J'ai laissé les données à transférer dans la page de "garde" Travaux (mais je voudrais qu'ils s'effacent sauf pour la date qui se modifie au jour le jour) et j'ai inscrit les données présentes dans cette page, dans les onglets correspondants avec la date du jour J.
J'espère que ce sera plus clair.

 

[job75]

Bonjour Dwindle, sousou,

Voyez le fichier joint et la macro du bouton Transférer :

Private Sub CommandButton1_Click() 'Transférer
Dim c As Range, w As Worksheet, arret As Boolean, cc As Range
'---contrôle des feuilles---
On Error Resume Next 'si la feuille n'existe pas
For Each c In [Tableau1].Columns(1).Cells 'tableau structuré
    If c <> "" Then
        Set w = Nothing
        Set w = Sheets(CStr(c))
        If w Is Nothing Then MsgBox "La feuille '" & c & "' n'existe pas, il faut la créer !", 48: arret = True
    End If
Next c
On Error GoTo 0
If arret Then Exit Sub
'---transferts---
For Each c In [Tableau1].Columns(1).Cells
    If c <> "" Then
        Set w = Sheets(CStr(c))
        Set cc = w.Range("A6:A" & w.Rows.Count).Find("*", , xlValues, , , xlPrevious) 'dernière cellule remplie
        cc(2) = Range("A1") 'date
        cc(2, 2).Resize(, 5) = c(1, 2).Resize(, 5).Value 'copie les valeurs
        If cc.Row > 6 Then cc.AutoFill cc.Resize(2), xlFillFormats 'copie le format en colonne A
    End If
Next c
End Sub

A+

 

[sousou]

bon c'est fait?

 

[Dwindle]

Oh, oui c'est top ! Merci.
Je vais essayer de comprendre votre code pour à l'avenir pouvoir le faire sur d'autre élément !

 

[job75]

Bon maintenant si l'on clique sur le bouton plusieurs fois dans la journée il faut penser aux doublons

Pour les supprimer utilisez ce fichier (2) avec la macro complétée :

Private Sub CommandButton1_Click() 'Transférer
Dim c As Range, w As Worksheet, arret As Boolean, cc As Range, tablo, ub&, i&, j%
'---contrôle des feuilles---
On Error Resume Next 'si la feuille n'existe pas
For Each c In [Tableau1].Columns(1).Cells 'tableau structuré
    If c <> "" Then
        Set w = Nothing
        Set w = Sheets(CStr(c))
        If w Is Nothing Then MsgBox "La feuille '" & c & "' n'existe pas, il faut la créer !", 48: arret = True
    End If
Next c
On Error GoTo 0
If arret Then Exit Sub
'---transferts---
For Each c In [Tableau1].Columns(1).Cells
    If c <> "" Then
        Set w = Sheets(CStr(c))
        Set cc = w.Range("A6:A" & w.Rows.Count).Find("*", , xlValues, , , xlPrevious) 'dernière cellule remplie
        cc(2) = Range("A1") 'date
        cc(2, 2).Resize(, 5) = c(1, 2).Resize(, 5).Value 'copie les valeurs
        If cc.Row > 6 Then cc.AutoFill cc.Resize(2), xlFillFormats 'copie le format en colonne A
        '---supprime les lignes en doublon---
        tablo = w.Range("A7:F" & cc.Row + 1) 'matrice, plus rapide
        ub = UBound(tablo)
        For i = ub - 1 To 1 Step -1
            For j = 1 To 6
                If tablo(i, j) <> tablo(ub, j) Then GoTo 1 'étudie chaque colonne
            Next j
            w.Rows(i + 6).Delete 'supprime la ligne entière
1       Next i
    End If
Next c
End Sub

 

[job75]

Enfin dans la foulée la macro peut créer la feuille si elle n'existe pas, fichier (3) :

Private Sub CommandButton1_Click() 'Transférer
Dim c As Range, w As Worksheet, i&, cc As Range, tablo, ub&, j%
If Sheets.Count = 1 Then MsgBox "Il faut au moins une feuille client comme modèle !", 48: Exit Sub
For Each c In [Tableau1].Columns(1).Cells
    If c <> "" Then
        Set w = Nothing
        On Error Resume Next 'si la feuille n'existe pas
        Set w = Sheets(CStr(c))
        On Error GoTo 0
        '---crée la feuille client---
        If w Is Nothing Then
            Application.ScreenUpdating = False
            Me.Move Before:=Sheets(1) 'au cas où...
            Sheets(2).Visible = xlSheetVisible 'si la feuille esst masquée
            Sheets(2).Copy After:=Sheets(Sheets.Count) 'copie la feuille
            Set w = ActiveSheet
            w.Name = c
            Me.Hyperlinks.Add c, "", "'" & c & "'!A1", TextToDisplay:=c.Text 'crée le lien hypertexte
            c.Font.Size = c(0).Font.Size 'copie la taille de la police
            w.Cells(1) = c
            w.Rows("8:" & w.Rows.Count).Delete 'RAZ
            w.Rows(7).ClearContents 'RAZ
            For i = 2 To Sheets.Count
                If LCase(c) < LCase(Sheets(i).Name) Then w.Move Before:=Sheets(i): Exit For 'ordre alphabétique
            Next i
            Application.Goto w.Cells(1), True 'cadrage
            Me.Select
        End If
        '---transfert---
        Set cc = w.Range("A6:A" & w.Rows.Count).Find("*", , xlValues, , , xlPrevious) 'dernière cellule remplie
        cc(2) = Range("A1") 'date
        cc(2, 2).Resize(, 5) = c(1, 2).Resize(, 5).Value 'copie les valeurs
        If cc.Row > 6 Then cc.AutoFill cc.Resize(2), xlFillFormats 'copie le format en colonne A
        '---supprime les lignes en doublon---
        tablo = w.Range("A7:F" & cc.Row + 1) 'matrice, plus rapide
        ub = UBound(tablo)
        For i = ub - 1 To 1 Step -1
            For j = 1 To 6
                If tablo(i, j) <> tablo(ub, j) Then GoTo 1 'étudie chaque colonne
            Next j
            w.Rows(i + 6).Delete 'supprime la ligne entière
1       Next i
    End If
Next c
End Sub

Le lien hypertexte est créé dans la 1ère feuille.

Edit : colorer les onglets n'a guère de sens...

 

[Dwindle]

Bonsoir,
Merci beaucoup pour tout ces codes !
Les couleurs des onglets c'est purement esthétique ^^ pour mieux différencier mes clients.

J'abuse de votre gentillesse, mais j'aimerais que les travaux de ma page Travaux s'efface après le transfert dans les onglets

Avez vous des astuces , des tutos pour comprendre un peu mieux les codes, les variables ? J'ai trouvé des tuto, des manuels mais cela me semble encore bien compliqué.
J'aimerais pouvoir être capable de créer ce genre de code, notamment pour inscrire sur cette même feuille de garde "travaux" la réception des paiements du jour pour chaque client et un calcul automatique du montant restant après le paiement de tel ou tel client.

Merci encore !

 

[job75]

Bonsoir Dwindle,

j'aimerais que les travaux de ma page Travaux s'efface après le transfert dans les onglets

Il suffit d'ajouter ce code en fin de macro, fichier (4) :

'---RAZ---
On Error Resume Next
[Tableau1].Delete xlUp

Il n'est alors plus nécessaire de créer le lien hypertexte quand une nouvelle feuille est créée.

Bonne nuit.

 

[job75]

Bonjour Dwindle,

Si le tableau de destination est filtré l'instruction :

Set cc = w.Range("A6:A" & w.Rows.Count).Find("*", , xlValues, , , xlPrevious) 'dernière cellule remplie

peut ne pas donner la bonne cellule.

Pour y remédier j'ai ajouté cette ligne de code, fichier (5) :

While cc(2) <> "": Set cc = cc(2): Wend 'si le tableau est filtré

A+

 

[Dwindle]

Merci beaucoup pour votre gentillesse.
Je n'ai pas pu vous répondre avant, désolé de cela !