Discussion :

[Tshr31]

Bonjour à tous,

Je travaille sous excel 365 et le problème se pose sur un classeur excel contenant plusieurs feuilles (dans l'exemple j'en ai mis 4 mais il peut y en avoir 50)

Je cherche une solution afin de récupérer un ensemble de cellule sur plusieurs ligne dans les différentes feuilles (1, 2, 3,...) pour lesquelles la valeur de la colonne statut est différente de "Annulée" ou "close" et de les reporter dans la feuille synthèse.

Je vous joins un fichier que j'ai épuré de toute données afin d'éclairer un peu plus mes propos.

Je précise que je souhaiterai réaliser l'opération par le déclenchement d'une macro par le bouton MAJ sur la feuille synthèse

En vous remerciant pour votre aide

essai_synthèse.xlsm

Thierry

[78chris]

Bonjour

Pourquoi ne pas utiliser les tableaux structurés qui existent depuis 19 ans ?

Une synthèse se fait alors en quelques clics avec PowerQuery disponible depuis 12 ans.

Synthèse actualisable à volonté...

[Tshr31]

Bonjour

Pourquoi ne pas utiliser les tableaux structurés qui existent depuis 19 ans ?

Une synthèse se fait alors en quelques clics avec PowerQuery disponible depuis 12 ans.

Synthèse actualisable à volonté...

Bonjour et merci de votre retour,

Je ne connais absolument pas power Query et qu'à terme les feuilles doivent être protégées et je crois qu'avec des tableaux structurés en plus de ne pas permettre une mise en page optimale (fusion de cellule, je sais vous allez crier au scandale) ne permettent pas la protection des feuilles (le tableau ne sera plus évolutif)

Thierry

[78chris]

RE

Effectivement la fusion, grande plaie d'Excel, inutile dans 99% des cas, n'est pas applicable dans les tableaux structurés

PowerQuery sait traiter les tableaux autres que structurés stockés dans des classeurs externes à celui de la synthèse donc ce n'est a priori pas bloquant et comme tout, cela s'apprend sans trop d'efforts a priori pour ce cas

[Tshr31]

J'ai déplacé la discussion dans la rubrique VBA qui me semble plus appropriée

Merci

[78chris]

RE

Donc alors que j'indique que PowerQuery est utilisable, tu renonces sans même essayer...

[Tshr31]

RE

Donc alors que j'indique que PowerQuery est utilisable, tu renonces sans même essayer...

Non je ne renonce pas c’est mal me connaître…
Seulement de ce que j’en ai vu il faut definir des données ce qui implique de devoir mettre a jour manuellement powerquery a chaque création ou suppression d’onglet ce qui est risqué a faire réaliser par l’utilisateur( risqie d’oubli d’un onglet ou de modification du parametrage)
L’utilisateur crée ou supprime des onglet a sa guise les renseigne et un recapitulatif des lignes de tous les onglets répondant aux critères est donné dans l’onglet synthèse ce qui lui permet un suivi global.
Thierry

[BENNASR]

Bonjour
Sans aucun doute la meilleure solution est powerquery
mais si t'insiste VBA je propose ce bricolage des débutants

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub regroup()
Application.ScreenUpdating = False
Dim w As Worksheet
Dim f2 As Worksheet
Set f2 = Sheets("Synthèse")
Dim derlig As Long
Dim lig As Long
derlig = f2.Cells(Rows.Count, 1).End(xlUp).Row
If derlig > 16 Then f2.Range(f2.Cells(17, "A"), f2.Cells(derlig, "I")).ClearContents
Dim i As Long
For Each w In ThisWorkbook.Worksheets
    If w.Name <> "Synthèse" Then
    w.Range("A16:I" & w.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=8, Criteria1:="<>Close" _
        , Operator:=xlAnd, Criteria2:="<>Annulée"
    lig = f2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    w.Range("A17:I" & w.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.Range("A" & lig)
    If w.FilterMode = True Then w.ShowAllData
    End If
    Next w
Application.ScreenUpdating = True
End Sub

[Tshr31]

Bonjour
Sans aucun doute la meilleure solution est powerquery
mais si t'insiste VBA je propose ce bricolage des débutants

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub regroup()
Application.ScreenUpdating = False
Dim w As Worksheet
Dim f2 As Worksheet
Set f2 = Sheets("Synthèse")
Dim derlig As Long
Dim lig As Long
derlig = f2.Cells(Rows.Count, 1).End(xlUp).Row
If derlig > 16 Then f2.Range(f2.Cells(17, "A"), f2.Cells(derlig, "I")).ClearContents
Dim i As Long
For Each w In ThisWorkbook.Worksheets
    If w.Name <> "Synthèse" Then
    w.Range("A16:I" & w.Range("A" & Rows.Count).End(xlUp).Row).AutoFilter Field:=8, Criteria1:="<>Close" _
        , Operator:=xlAnd, Criteria2:="<>Annulée"
    lig = f2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    w.Range("A17:I" & w.Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy Destination:=f2.Range("A" & lig)
    If w.FilterMode = True Then w.ShowAllData
    End If
    Next w
Application.ScreenUpdating = True
End Sub

Bonjour BENNASR,

Je te remercie pour ta macro elle fonctionne à merveille.

Je comprends que Power Query répond mieux à cette problématique, mais vu l'utilisation je préfère grandement cette solution plus fiable à mon sens entre les mains d'utilisateur pau habitué à utiliser PowerQuery.

J'aurai une dernière requête, j'aimerai que le numéro reporté en colonne A sur la synthèse soit un lien hypertexe de façon qu'en cliquant dessus j'arrive sur la bonne ligne de la bonne feuille, est possible?

Merci de ton aide

Thierry

[78chris]

Bonjour

Seulement de ce que j’en ai vu il faut definir des données ce qui implique de devoir mettre a jour manuellement powerquery a chaque création ou suppression d’onglet ce qui est risqué a faire réaliser par l’utilisateur( risqie d’oubli d’un onglet ou de modification du parametrage)
L’utilisateur crée ou supprime des onglet a sa guise les renseigne et un recapitulatif des lignes de tous les onglets répondant aux critères est donné dans l’onglet synthèse ce qui lui permet un suivi global.

Eh non !

Il suffit de travailler en Tableaux structurés et de les nommer avec une même racine, T_ par exemple, et tout nouveau tableau est automatiquement traité de même que tout tableau disparu est de fait "oublié"...

En revanche pas d'hyperlien sans VBA

[Tshr31]

Bonjour



Eh non !

Il suffit de travailler en Tableaux structurés et de les nommer avec une même racine T_ par exemple et tout nouveau tableau est automatiquement traité de même que tout tableau disparu est de fait "oublié"...

Bonjour 78Chris,

Je ne suis pas fermé au Power Query mais je ne connais pas le peu je j'ai vu mes semble compliqué, si sur la base du fichier exemple que j'ai fourni vous pouviez me faire la base que je puisse par la suite l'adapter car partir de 0, je n'ai pas le temps nécessaire pour appréhender powerquery.

Merci

[BENNASR]

Bonjour
j'ai bricolé ce qui suit (avec un dictionnaire et non pas par filtre :
NB :
1- j'ai annuler la fusion de cellules des l'onglet synthèse et des autres onglet ... la fusion des cellules est déconseillé pour la programmation VBA
2 - récupérer le nom de l'onglet dans la colonne K de l'onglet synthèse et en colonne L le numéro de la ligne
puis en double clic sur le nom de l'onglet tu va déplacer sur la feuille correspondante et sur la ligne en quetion
tester et dire si ça te permet d'avancer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub regroup()
Application.ScreenUpdating = False
Dim w As Worksheet
Dim f2 As Worksheet
Set f2 = Sheets("Synthèse")
Dim derlig As Long
Dim lig As Long
derlig = f2.Cells(Rows.Count, 1).End(xlUp).Row
If derlig > 16 Then f2.Range(f2.Cells(17, "A"), f2.Cells(derlig, "L")).ClearContents
Dim i As Long
Set d = CreateObject("Scripting.Dictionary")
For Each w In ThisWorkbook.Worksheets
On Error Resume Next
    If w.Name <> "Synthèse" Then
    TblBD = w.Range("A17:I" & w.Range("A" & Rows.Count).End(xlUp).Row)
     For i = 1 To UBound(TblBD)
          If TblBD(i, 8) <> "Close" And TblBD(i, 8) <> "Annulée" Then
          clé = TblBD(i, 1) & "|" & TblBD(i, 2) & "|" & TblBD(i, 3) & "|" & TblBD(i, 4) & "|" & TblBD(i, 5) & "|" & TblBD(i, 6) & "|" & CDate(TblBD(i, 7)) & "|" & TblBD(i, 8) & "|" & TblBD(i, 9) & "|" & "" & "|" & w.Name & "|" & (i + 16)
          d(clé) = d(clé)
          End If
    Next i
    End If
  Next w
  f2.Range("A17").Resize(d.Count) = Application.Transpose(d.keys)
  Application.DisplayAlerts = False
   f2.Range("A17").Resize(d.Count).TextToColumns Other:=1, DataType:=xlDelimited, OtherChar:="|"
Application.ScreenUpdating = True
End Sub

pour le déplacement vers l'onglet source:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim onglet As String
Dim ligne As Integer
onglet = ActiveCell.Value
ligne = Cells(ActiveCell.Row, "L")
Sheets(onglet).Select
ActiveSheet.Cells(ligne, 1).Select
End Sub

[78chris]

Re

Je ne suis pas fermé au Power Query mais je ne connais pas le peu je j'ai vu mes semble compliqué, si sur la base du fichier exemple que j'ai fourni vous pouviez me faire la base que je puisse par la suite l'adapter car partir de 0, je n'ai pas le temps nécessaire pour appréhender powerquery.

Les tableaux structurés n'acceptent pas les cellules fusionnées (une de plaies d'Excel y compris pour VBA) ce pourquoi j'ai renoncé à modéliser à partir de ton fichier

Un exemple illustré ici http://www.excel-formations.fr/Trucs_astuces/PQ04.php

[Pierre Dumas]

Bonsoir

Je ne suis pas fermé au Power Query mais je ne connais pas le peu je j'ai vu mes semble compliqué, si sur la base du fichier exemple que j'ai fourni vous pouviez me faire la base que je puisse par la suite l'adapter car partir de 0, je n'ai pas le temps nécessaire pour appréhender powerquery.

Voilà à quoi cela me fait penser.




Et c'est bien dommage

Bonne soirée

Pierre Dumas

[BENGR]

Excellente image...à l'inverse moi je tire la charrette et pas grand monde sur mon chemin ; si un expert pouvait m'aider un peu...(Forum Excel)

[Tshr31]

Bonjour à tous

Avec beaucoup de lecture et l'aide de quelque un d’entre vous j'ai réussi à créer une macro qui répond exactement à mon besoin.

Certe les puriste y trouveront certainement à redire, mais n'étant pas un développeur VBA, je crée des macros dans un but de me simplifier la tache.

Du coup je la poste si elle peut aider d'autre personne qui comme moi cherchait un déblocage pour obtenir une macro répondant à son besoin

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Option Explicit
 
Sub Liste()
 
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.EnableEvents = False
 
Dim Feuille As Worksheet                    ' Feuilles
Dim Fsynth As Worksheet                     ' Feuille synthèse
    Set Fsynth = Feuil2      ' Définition feuille de synthèse
 
Dim lvS As Long     ' 1er ligne vide de la feuille synthèse
Dim dlS As Long     ' Détermination de la dernière ligne de la feuille synthèse
Dim dlF As Long     ' Détermination de la dernière ligne de la feuille traitée
Dim n As Long       ' Numéro de la ligne en cours dans la feuille traitée
 
Dim c As Range      ' Cellule devant repondre au critère dans la feuille traitée
Dim rngc As Range   ' Plage des cellules devant repondre au critère dans la feuille traitée
Dim rngtbl As Range
 
Fsynth.Select
ActiveSheet.Unprotect ""
 
lvS = Fsynth.Range("A" & Rows.Count).End(xlUp).Row + 1     ' Détermination de la 1ere ligne vide sur la synthèse
 
If lvS > 17 Then Fsynth.Range("A17:k" & lvS).Delete        ' si 1ere ligne vide sur la synthèse > 17 alors on supprime toutes les données
 
lvS = Fsynth.Range("A" & Rows.Count).End(xlUp).Row + 1     ' Détermination de la 1ere ligne vide sur la synthèse
 
Fsynth.Range("A" & lvS).Select     ' Sélection de la cellule en colonne A de la 1ere ligne vide sur la synthèse
 
    For Each Feuille In ThisWorkbook.Worksheets     ' Traitement de chaque feuille du classeur
 
        If (Feuille.Name <> "Paramètres" And Feuille.Name <> "Synthèse" And Feuille.Name <> "CR" And Left(Feuille.Name, 3) <> "Exp") Then     ' On exclue les feuilles...
 
        dlF = Feuille.Range("A" & Rows.Count).End(xlUp).Row     'Détermination de la dernière ligne de la feuille traité
 
        For n = 17 To dlF       ' On va traiter de la ligne 17 à la derniere ligne de la feuille en cours
            ' On défini les critères pour lesquels on veut récupérer les lignes
            If ((Feuille.Range("H" & n) = "" And IsNumeric(Feuille.Range("A" & n)) = True) Or (Feuille.Range("H" & n) = "Ouverte" And IsNumeric(Feuille.Range("A" & n)) = True) Or (Feuille.Range("H" & n) = "25%" And IsNumeric(Feuille.Range("A" & n)) = True) Or (Feuille.Range("H" & n) = "50%" And IsNumeric(Feuille.Range("A" & n)) = True) Or (Feuille.Range("H" & n) = "75%" And IsNumeric(Feuille.Range("A" & n)) = True) Or (Feuille.Range("H" & n) = "100%" And IsNumeric(Feuille.Range("A" & n)) = True)) Then
            Feuille.Range("A" & n & ":I" & n).Copy Destination:=Fsynth.Range("A" & lvS)        ' On copie la ligne répondant au critère et on la colle dans la synthèse
            ' On défini un lien hyper texte vers la ligne de la feuille concernée
            Fsynth.Range("A" & lvS).Hyperlinks.Add Anchor:=Fsynth.Range("A" & lvS), Address:="", SubAddress:="'" & Feuille.Name & "'!A" & n & ":I" & n & " "
            lvS = Fsynth.Range("A" & Rows.Count).End(xlUp).Row + 1     ' Détermine la nouvelle ligne vide sur la synthèse pour coller la nouvelle ligne répondant au critère toujours sur la même feuille
 
            End If
        Next
 
        lvS = Fsynth.Range("A" & Rows.Count).End(xlUp).Row + 1     ' Détermine la nouvelle ligne vide sur la synthèse pour coller la nouvelle ligne répondant au critère de la nouvelle feuille
 
        End If
 
    Next
 
dlS = Fsynth.Range("A" & Rows.Count).End(xlUp).Row      ' mise à jour de la dernière ligne dans le bilan
 
Set rngtbl = Range(Cells(17, 1), Cells(dlS, 9))         ' définition plage tableau synthèse
 
' mise en forme tableau synthèse
rngtbl.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = RGB(14, 56, 102)
        .TintAndShade = 0
        .Weight = xlMedium
    End With
 
Fsynth.Select
ActiveSheet.Protect ""
Fsynth.Range(Cells(8, 3).Address).Select
 
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.EnableEvents = True
 
MsgBox "La mise à jour est terminée", 64, "Etat de mise à jour"
 
End Sub