Exercice N° 5 - Faire une Synthèse d'onglet

Mimimathy · Octobre 4, 2018, 4:37

Bonjour à tous,

Sur cet exercice N°5, faire une synthèse sur cette feuille de tous les onglets présents, ainsi que d’éventuel nouveau onglet.

Regrouper des onglets sur une feuille.xlsx (18,7 Ko)

mdo100 · Octobre 4, 2018, 6:04

Salut @Mimimathy,

Je regarderai ça plus tard, trop fatigué là ce soir

Et puis je laisse de l’avance pour l’ami @kiss6 où d’autre qui sont les bienvenus (es).

mdo100 · Octobre 5, 2018, 8:11

Erreur dans la réponse

ilies_meziani · Octobre 6, 2018, 12:10

Bonsoir
Voici un test Regrouper des onglets sur une feuille le 06 oct 2018.xlsm (33,6 Ko)
Bonne nuit

Mimimathy · Octobre 6, 2018, 5:17

Bonjour ilies,

Il y a de cela,
si la macro était commentée, se serait mieux pour les autres membres, cela montrerais que tu comprends tes instructions

Néanmoins, il te manque les noms de clients dans la synthèse et la macro est un peu à rallonge, et je n’ai pas besoin de Tableau
Et si je rajoutes un ou plusieurs onglets avec des autres clients, ils ne sont pas pris en compte

Encore un petit effort pour me placer les noms de clients

mdo100 · Octobre 6, 2018, 7:31

Salut @Mimimathy,
Salut @ilies_meziani,

@Mimimathy, Bon tu vas pouffer de rire mais voici ma solution qui a quand même l’avantage de fonctionner, même si je sais que mon code ressemble plus à du bricolage, qu’à un code de pro.

Le code:

Sub Rassembler()
Dim x&, Dl&, Sh As Worksheet, Sy As Worksheet 'Les variables

Application.ScreenUpdating = False 'Rafraichissement ecran
    
 Set Sy = Sheets("Synthese") 'Selection de la feuille Synthese
 Sy.Range("A8:F" & Sy.[A65000].End(xlUp).Row).ClearContents 'efface les anciennes donnees
    
 Feuil1.Select 'A partir de la feuille 1
 'Boucle sur toutes les feuilles sauf la feuille 6 (Synthese)
 For x = 2 To ThisWorkbook.Sheets.Count
    If Sheets(x).Name <> "Feuil6" Then Sheets(x).Select Replace:=False
 Next x
 
    'Copier la formule jusqu'? la derni?re ligne non vide colonne F
    Range("F8").Select
    'Indiquer le nom des la feuille client a partir de F8
        ActiveCell.FormulaR1C1 = _
        "=MID(CELL(""filename"",RC[-5]),FIND(""]"",CELL(""filename"",R[-7]C[-5]))+1,20)"
        Selection.AutoFill Destination:=Range("F8:F" & Range("A65536").End(xlUp).Row)
        
    Columns("F:F").Select 'Selection des colonnes F
    Selection.Copy 'Copier les formules
    'Remplace les formules par leurs valeurs
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    'Boucle sur toutes les feuilles sauf feuille Synthese (Sy)&
    'Copier toutes les colonnes de A8 a Fx sur la feuille Synthese
    For Each Sh In Worksheets
        If Sh.Name <> Sy.Name Then
            Dl = Sh.Range("A" & Rows.Count).End(xlUp).Row
            Sh.Range("A8:F" & Dl).Copy Destination:= _
            Sy.Range("A" & Rows.Count).End(xlUp)(8)
        End If
    Next
    
 Sheets("Synthese").Activate 'Active la feuille Synthese
 
 'Supprimme les lignes vides
 [A8:A65000].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
  Feuil1.Select 'A partir de la feuille 1
  'Boucle sur toutes les feuilles sauf la feuille 6 (Synthese)
 For x = 2 To ThisWorkbook.Sheets.Count
    If Sheets(x).Name <> "Feuil6" Then Sheets(x).Select Replace:=False
 Next x
 
    Columns("F:F").Select 'Selection des colonnes F
    Selection.ClearContents 'efface le contenu des colonnes F
    Range("A1").Activate 'Range curseur dans A1
    
 Sheets("Synthese").Activate 'Revenir sur la feuille Synthese
    'Replace les saisies
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "Date saisie"
    Range("B7").Select
    ActiveCell.FormulaR1C1 = "Ref"
    Range("C7").Select
    ActiveCell.FormulaR1C1 = "Date d?p?t"
    Range("D7").Select
    ActiveCell.FormulaR1C1 = "Montant"
    Range("E7").Select
    ActiveCell.FormulaR1C1 = "Observation"
    Range("F7").Select
    ActiveCell.FormulaR1C1 = "Nom du Client"
    Range("F8").Select
 
End Sub

Le fichier Regrouper des onglets sur une feuille V1 .xlsm (31,6 Ko)

PS: Salut @kiss6,
@+

Mimimathy · Octobre 6, 2018, 7:54

Bonjour à tous,

Salut MDO, je ne dis rien , c’est fonctionnel

Mais je m’attendais quand même à mieux

Alors, ma macro , jai rajouté un tri sur les dates de la colonne A, vous verrez pourquoi sur le prochain exercice

Option Explicit

Dim i%, Lr%, Dl%
Dim Ws As Worksheet, Wd As Worksheet

Sub Rassembler()
  Application.ScreenUpdating = False 'Désaction du rafraichissement d'écran
  Set Wd = Sheets("Synthese") 'Attribue une référence d'objet à la variable WD (Synthese)
  Lr = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1 '1ère ligne vide de WD (Synthese)
  If Lr > 8 Then Wd.Range(Cells(8, 1), Cells(Lr, 6)).Clear 'Si Lr est sup à 8, j'efface les données
  For Each Ws In Worksheets 'Boucle sur tous les onglets
    If Ws.Name <> "Synthese" Then 'Si le nom de l'onglet est différent de Synthese
      Dl = Ws.Range("A" & Rows.Count).End(xlUp).Row 'Je récupère la derniere ligne de cet onglet
        For i = 8 To Dl 'boucle de la ligne 8 à la derniere de l'onglet
            Lr = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1 '1ère ligne vide de WD (Synthese)
            With Ws 'avec cet onglet
              .Range(.Cells(i, 1), .Cells(i, 5)).Copy Wd.Cells(Lr, 1) 'je copie une par une les lignes
              Wd.Cells(Lr, 6).Value = Sheets(Ws.Name).Name 'et j'ajoute le nom de l'onglet dans la colonne F
              Application.CutCopyMode = False
            End With
        Next i 'ligne suivante
    End If
  Next Ws 'Onglet suivant
  Tri 'Lance la macro Tri pour les dates en colonne A
End Sub

Sub Tri()
    Lr = Wd.Range("A" & Rows.Count).End(xlUp).Row 'derniere ligne de WD (Synthese)
    Range("A7").CurrentRegion.Select 'Sélection de tous les données
    ActiveWorkbook.Worksheets("Synthese").Sort.SortFields.Clear 'Active la filtre pour trier sur la colonne A en ascendant
    ActiveWorkbook.Worksheets("Synthese").Sort.SortFields.Add Key:=Range("A8:A" & Lr _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Synthese").Sort
        .SetRange Range("A7:F" & Lr) 'Je continue le tri jusqu'à dernière ligne
        .Header = xlYes 'Entête présente
        .Apply 'J'applique le tri
    End With
    Range("A7").Select
End Sub

Regrouper des onglets sur une feuille.xlsm (26,3 Ko)

mdo100 · Octobre 6, 2018, 8:28

Re @Mimimathy,

Bon tu n’es pas un merle moqueur pour mon code amateur l’élève n’étant pas encore à la hauteur du maître

Puis te demander pourquoi, tu n’as pas mis le code Tri sur date directement dans le premier code ?

Je viens de le faire et ça fonctionne bien.

Option Explicit

Dim i%, Lr%, Dl%
Dim Ws As Worksheet, Wd As Worksheet

Sub Rassembler()
  Application.ScreenUpdating = False 'D?saction du rafraichissement d'?cran
  Set Wd = Sheets("Synthese") 'Attribue une r?f?rence d'objet ? la variable WD (Synthese)
  Lr = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1 '1?re ligne vide de WD (Synthese)
  If Lr > 8 Then Wd.Range(Cells(8, 1), Cells(Lr, 6)).Clear 'Si Lr est sup ? 8, j'efface les donn?es
  For Each Ws In Worksheets 'Boucle sur tous les onglets
    If Ws.Name <> "Synthese" Then 'Si le nom de l'onglet est diff?rent de Synthese
      Dl = Ws.Range("A" & Rows.Count).End(xlUp).Row 'Je r?cup?re la derniere ligne de cet onglet
        For i = 8 To Dl 'boucle de la ligne 8 ? la derniere de l'onglet
            Lr = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1 '1?re ligne vide de WD (Synthese)
            With Ws 'avec cet onglet
              .Range(.Cells(i, 1), .Cells(i, 5)).Copy Wd.Cells(Lr, 1) 'je copie une par une les lignes
              Wd.Cells(Lr, 6).Value = Sheets(Ws.Name).Name 'et j'ajoute le nom de l'onglet dans la colonne F
              Application.CutCopyMode = False
            End With
        Next i 'ligne suivante
    End If
  Next Ws 'Onglet suivant
    
    'Tri sur les dates de la colonne A
    Lr = Wd.Range("A" & Rows.Count).End(xlUp).Row 'derniere ligne de WD (Synthese)
    Range("A7").CurrentRegion.Select 'S?lection de tous les donn?es
    ActiveWorkbook.Worksheets("Synthese").Sort.SortFields.Clear 'Active la filtre pour trier sur la colonne A en ascendant
    ActiveWorkbook.Worksheets("Synthese").Sort.SortFields.Add Key:=Range("A8:A" & Lr _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Synthese").Sort
        .SetRange Range("A7:F" & Lr) 'Je continue le tri jusqu'? derni?re ligne
        .Header = xlYes 'Ent?te pr?sente
        .Apply 'J'applique le tri
    End With
    Range("A7").Select

End Sub

Regrouper des onglets sur une feuille Mimimathy V1.xlsm (28,5 Ko)

@ te relire

Mimimathy · Octobre 6, 2018, 8:34

Re,

Tout à fait, cela fonctionne aussi.
De mon côté, j’aime assez bien différentier les rôles des macros

Imagine que je te demande par un déroulant de faire un tri pour chaque catégorie

Par Ref
Par Date de dépôt
Par Montant

Tu me places un menu déroulant dans la feuille Synthèse avec comme choix, ceux précisés plus haut, sans oublier par Client et par Date de Saisie (donc 5 choix), et tu me fait une macro de Tri
Le menu déroulant créé par VBA et non par Validation de données.

J’attend la macro

Mimimathy · Octobre 12, 2018, 5:22

Bonjour,

Voici la solution pour le tri sélectif suivant la valeur du ComboBox

Le ComboBox est initialisé à l’ouverture du classeur par ThisWorkbook

Regrouper des onglets sur une feuille.xlsm (36,5 Ko)

mdo100 · Octobre 12, 2018, 5:48

Salut @Mimimathy,

Pouah je n’avais pas du tout compris ça, je pensais qu’une fois le choix de la Combobox, il faillait pouvoir choisir avec une autre Combobox par Date ou par Réf etc… pour préciser la recherche du tri.

Je me suis casser le cerveau pour rien, alors que tu demandais quelque chose de plus simple.

Bon je me console avec ta solution et en me disant que tu avais mal expliquer l’Exercice .

Bonne journée