Macro feuille récapitulative de feuilles variables

Version imprimable

14/04/2014, 20h23
tif04

1 pièce(s) jointe(s)

Macro feuille récapitulative de feuilles variables

bonjour le forum,
je patauge pas mal depuis un moment
je recherche une macro (et uniquement une macro) qui me récapitulerait sur une feuille appelée synthèse, les dépenses sur différentes feuilles créées au fur et à mesure
ci-joint un fichier simplifié avec le résultat à obtenir sur la feuille synthèse (ici pour 2 feuilles)
merci d'avance
15/04/2014, 09h06
Gado2600

Bonjour,
Je pense que la solution est plutôt simple.
Dans chacun des onglets des dépenses, il faut que tu ais une cellule ou valeur de référence.
Cela peut être "Date", "Dépense", "Nature" ou une cellule bien précise (voir une colonne ou une ligne).

Bref, il te faut une référence de départ.
Une fois que tu as celle-ci, il te suffit de parcourir chacune des feuilles dont le nom correspond à ta recherche ou une partie du nom correspond à ton type de feuille (tu peux même utiliser ce qu'on appelle les codename).

A partir du moment où tu arrives à les parcourir, ensuite à trouver ta cellule de départ, à parcourir les informations de chacune des feuilles, la suite consistera à copier ces données.

Cordialement,
15/04/2014, 10h30
tif04

merci Gado
mais je suis débutant en VBA, bref j'y connais pas grand chose
une précision les feuilles dépenses seront rajouter au fur et à mesure
je pense à une syntaxe: pour chaque feuille de 1 à nb de feuille existantes moins récap copier dans feuille synthèse les valeurs des cellules dates,dépenses...
mais en VBA pour moi c'est hard
si tu peux m'écrire la macro correspondantese serait bien
a+
15/04/2014, 10h30
casefayere

Bonjour,

essayes ce fichier basé sur ton modèle et dis-moi tout
15/04/2014, 19h48
tif04

un grand merci casefayere, c'est exactement ce que je voulais
je vais essayer de comprendre la macro et l'appliquer sur mon travail
a+ sur le forum
15/04/2014, 20h01
casefayere

Citation:

Envoyé par tif04

un grand merci casefayere, c'est exactement ce que je voulais
je vais essayer de comprendre la macro et l'appliquer sur mon travail
a+ sur le forum

il n'y a pas de quoi, ça me rassure car apparemment ça ne plait pas à tout le monde, vu le bas de mon message, allez savoir !
15/04/2014, 20h38
Marc-L

Ah toi aussi … Pour la peine :plusser: !

Merci Marc, tant que j'y suis, je colle mes codes avec explications (j'espère suffisantes) pour tif04
Procédure du bouton de commande

Code:

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
Private Sub CommandButton1_Click()
Dim cel As Range
x = 0: y = 0 'j'initialise les variables par sureté
For Each Ws In Worksheets 'on parcoure les feuilles avec la boucle
  If Ws.Name Like "dépense" & "*" Then 'on vérifie que le nom des feuilles commencent par "dépense"
    Set Derlg = Ws.Range("A" & Ws.Rows.Count).End(xlUp) 'derniere cellule utilisée
    x = x + Derlg.Row - 1 'au début en feuille "dépense1" x = 0 + 3 - 1, 2eme boucle x = 2 + 3 -1, etc.
  End If
Next Ws
 
'maintenant qu'on a le nombre de lignes total, on redimensionne le tableau, ci-dessous
ReDim Tbl(1 To x, 1 To 3) 'dans notre exemple 4 lignes et 3 colonnes
For Each Ws In Worksheets 'on reparcoure les feuilles pour affecter les données au tableau
  If Ws.Name Like "dépense" & "*" Then
    Set Derlg = Ws.Range("A" & Ws.Rows.Count).End(xlUp) 'derniere cellule utilisée
    For x = 2 To Derlg.Row
      y = y + 1
      Tbl(y, 1) = Ws.Range("C" & x) 'je commence par "nature"
      Tbl(y, 2) = Ws.Range("A" & x) 'la date
      Tbl(y, 3) = Ws.Range("B" & x) 'la dépense
    Next x
  End If
Next Ws
Tri_tbl 'on va dans la procédure de tri (en module 1)
Set Derlg = Sheets("synthèse").Range("A" & Sheets("synthèse").Rows.Count).End(xlUp)
If Derlg.Row > 1 Then Sheets("synthèse").Range("A2", Derlg(1, 3)).ClearContents 'on vide les valeurs de "synthèse
Sheets("synthèse").Range("A2").Resize(UBound(Tbl, 1), UBound(Tbl, 2)) = Tbl 'et on lui réaffecte les nouvelles valeurs
With Sheets("synthèse")
  Set Derlg = .Range("A" & .Rows.Count).End(xlUp)
  'ci-dessous, j'enlève les doublons en A
  For Each cel In .Range("A3", Derlg)
    If cel = cel(0, 1) Then cel.ClearContents
  Next cel
End With
End Sub

Procédure de tri en module 1 + les variables publiques

Code:

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
Option Explicit
Public Tbl()
Public Derlg As Range, Ws As Worksheet
Public Nb As Long, x As Long, y As Long, z As Integer
 
Sub Tri_tbl() 'procédure de tri ascendant
'Dim x As Integer
Dim Cible As String
 
For z = 1 To 2 'boucle qui reprendra 2 tris => 1 sur "Nature", 2 sur "Date"
  Do 'voir l'aide "F1"
    x = 0 'j'initialise la variable par sureté
    For y = 1 To UBound(Tbl) - 1 'boucle sur les éléments de la variable tableau
      If Tbl(y, z) > Tbl(y + 1, z) Then 'donc au début => si "reparation" est plus grand que "voiture"
      'si oui
        Cible = Tbl(y, 1) & ":" & Tbl(y, 2) & ":" & Tbl(y, 3) 'au début, cible = "reparation:01/03/2014:1000"
        Tbl(y, 1) = Tbl(y + 1, 1): Tbl(y, 2) = Tbl(y + 1, 2): Tbl(y, 3) = Tbl(y + 1, 3) 'on affecte les valeurs des éléments suivants
         'ci-dessous, et les éléments suivant sont réaffectés par les éléments précédents
        Tbl(y + 1, 1) = Split(Cible, ":")(0)
        Tbl(y + 1, 2) = Split(Cible, ":")(1)
        Tbl(y + 1, 3) = Split(Cible, ":")(2)
        x = 1
      End If
    Next y
  Loop While x = 1
  'ensuite on recommence pour le tri par date
Next z
End Sub

17/04/2014, 07h24
tif04

merci casefayere pour l'effort d'explication (j'ai rajouté 1point bien mérité)

une autre question casefayere (ou autre)
quelle macro si on devait garder la structure des feuilles dépenses sans passer par tableau c.a.d copier les plages (ou cellules?) à la suite dans synthèse et trier par nature dépense
merci

Bonjour ,le forum, tif04

Citation:

Envoyé par tif04

une autre question casefayere (ou autre)
quelle macro si on devait garder la structure des feuilles dépenses sans passer par tableau c.a.d copier les plages (ou cellules?) à la suite dans synthèse et trier par nature dépense
merci

Si ton souhait est ne ne pas passer par une variable(tableau), pour te former, je te conseille de passer par l'enregistreur de macros, je ne connais pas ta version, sinon sur Excel2007 : "Enregistrer une macro" => tu fais ce que tu souhaites => tu arrêtes la macro et regardes le résultat dans l'éditeur. Il ne te restera pus qu'à nettoyer l'inutile. La macro te donnerait quelque chose comme ça, pas joli du tout mais tu pourras l'adapter :

Code:

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
Sub Macro1()
'
' Macro1 Macro
'
 
'
    Range("A2:C3").Select
    Selection.Copy
    Sheets("synthèse").Select
    Range("A2:C3").Select
    ActiveSheet.Paste
    Sheets("dépense2").Select
    Range("A2:C3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("synthèse").Select
    Range("A4:C5").Select
    ActiveSheet.Paste
    Range("A2:C5").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("synthèse").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("synthèse").Sort.SortFields.Add Key:=Range("C2:C5") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("synthèse").Sort.SortFields.Add Key:=Range("A2:A5") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("synthèse").Sort
        .SetRange Range("A1:C5")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

je te laisse donc faire et on corrigera à notre façon.

PS : Comme mon bon coeur me perdra, voici 2 solutions (j'ai remis la colonne "nature" en col C)
1ère solution avec copie :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Macro1()
Dim Derlg As Range, Ws As Worksheet, DerCible As Range
With Sheets("synthèse")
  Set DerCible = .Range("C" & .Rows.Count).End(xlUp)
  If DerCible.Row > 1 Then .Range("A2", DerCible).ClearContents
  For Each Ws In Worksheets
    If Ws.Name Like "dépense" & "*" Then
      Set DerCible = .Range("A" & .Rows.Count).End(xlUp)(2, 1)
      Set Derlg = Ws.Range("C" & Ws.Rows.Count).End(xlUp)
      Ws.Range("A2", Derlg).Copy DerCible
    End If
  Next Ws
  Application.CutCopyMode = False
  Set DerCible = .Range("C" & .Rows.Count).End(xlUp)
  .Range("A2", DerCible).Sort Key1:=.Range("C2"), Order1:=xlAscending, Key2:=.Range("A2"), Order2:=xlAscending, Header:=xlGuess
  For Each Derlg In .Range("C2", DerCible)
    If Derlg(0, 1) = Derlg Then Derlg.ClearContents
  Next Derlg
 
End With
 
End Sub

2ème solution avec copiage des valeurs

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Macro2()
Dim Derlg As Range, Ws As Worksheet, DerCible As Range
With Sheets("synthèse")
  Set DerCible = .Range("C" & .Rows.Count).End(xlUp)
  If DerCible.Row > 1 Then .Range("A2", DerCible).ClearContents
  For Each Ws In Worksheets
    If Ws.Name Like "dépense" & "*" Then
      Set DerCible = .Range("A" & .Rows.Count).End(xlUp)(2, 1)
      Set Derlg = Ws.Range("C" & Ws.Rows.Count).End(xlUp)
      DerCible.Resize(Derlg.Row - 1, 3).Value = Ws.Range("A2", Derlg).Value
    End If
  Next Ws
  Application.CutCopyMode = False
  Set DerCible = .Range("C" & .Rows.Count).End(xlUp)
  .Range("A2", DerCible).Sort Key1:=.Range("C2"), Order1:=xlAscending, Key2:=.Range("A2"), Order2:=xlAscending, Header:=xlGuess
  For Each Derlg In .Range("C2", DerCible)
    If Derlg(0, 1) = Derlg Then Derlg.ClearContents
  Next Derlg
End With
 
End Sub

17/04/2014, 11h11
mercatog

Citation:

Envoyé par casefayere

il n'y a pas de quoi, ça me rassure car apparemment ça ne plait pas à tout le monde, vu le bas de mon message, allez savoir !

Peut être que le mécontent n'attendait pas uniquement un fichier joint sèchement, mais plutôt un code ou un début de code (expliqué ou non ça reste le choix du demandeur de demander des précisions ou de se contenter de copier littéralement la proposition).
Comme les fichiers joints ne sont proposés qu'en dernier lieu pour les questions et sera plus pour les réponses, personnellement, je suis d'accord sur le principe.

Mais ne t'en fais pas, tu vas récupérer vite vu ton dévouement pour aider autrui et pour le temps consacré à l'entraide.
17/04/2014, 11h17
casefayere

Bonjour,
tu as certainement raison, quoique je trouve ça un peu léger.

quand tu écris

Citation:

Mais ne t'en fais pas, tu vas récupérer vite vu ton dévouement pour aider autrui et pour le temps consacré à l'entraide.

Je te rassure, je ne fais pas la course aux points, j'aime ce que je fais et ça me suffit, je te remercie pour le reste de la phrase.

Bonne journée mercatog
17/04/2014, 11h46
mercatog

C'est pas une course aux points mais ça reste un signe d'encouragement et de reconnaissance anonymes.
17/04/2014, 21h39
tif04

1 pièce(s) jointe(s)

encore merci casefayere mais ça ne marche pas quand j'intègre ta (ou tes) formule en l'adaptant je ne suis pas assez expert
je te renvoie le fichier d'origine en fait les feuilles dépenses sont des feuilles excel (non destructurables) avec du texte qu'il ne faut pas prendre en compte pour la synthèse; et ne pas oublier que des feuilles vont se rajouter au fur et à mesure des dépenses
ben si tu te sens le courage!

Bonsoir

Une proposition

Code:

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
Option Explicit
 
Sub Synthese()
Dim Ws As Worksheet
Dim NewLig As Long
 
Application.ScreenUpdating = False
With Worksheets("synthèse")
    .UsedRange.ClearContents
    .Range("A1:C1") = Array("Date", "Dépense", "Nature")
    For Each Ws In Worksheets
        If Ws.Name Like "dépense*" Then
            NewLig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            Repart Ws, NewLig
        End If
    Next Ws
    .Range("A1:C" & NewLig).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
End With
End Sub
 
Private Sub Repart(ByVal Ws As Worksheet, ByRef Lig As Long)
Dim Titre As String, Prem As String
Dim c As Range
 
Titre = "dépense"
With Ws.UsedRange
    Set c = .Find(Titre, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
        Prem = c.Address
        Do
            c.Offset(1, -1).Resize(1, 3).Copy Worksheets("synthèse").Cells(Lig, 1)
            Lig = Lig + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Prem
    End If
End With
End Sub

17/04/2014, 22h15
tif04

super mercatog ça marche!!!; la classe à tous les deux avec casefayere
merci d'avoir la patiente pour nous aider, nous les débutants
bonne soirée à tous les deux et peut être à bientôt sur le forum :)

Je crois que j'avais fais une bêtise de logique. Je mérite un -1. Le code modifié suivant suffit:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub Synthese() Dim Ws As Worksheet Dim NewLig As Long Application.ScreenUpdating = False With Worksheets("synthèse") .UsedRange.ClearContents .Range("A1:C1") = Array("Date", "Dépense", "Nature") NewLig = 2 For Each Ws In Worksheets If Ws.Name Like "dépense*" Then Repart Ws, NewLig Next Ws .Range("A1:C" & NewLig).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes End With End Sub
PS. Il ne suffit pas de copier le code et de le tester mais de se l'approprier pour le faire évoluer ou maintenir sans aide externe.

17/04/2014, 23h21
tif04

Citation:

PS. Il ne suffit pas de copier le code et de le tester mais de se l'approprier pour le faire évoluer ou maintenir sans aide externe

je suis d'accord avec toi mais vu la formule se sera dur, pour ce qui est simple ça va mais là...
ça reste quand même une affaire d'expert où alors il faut avoir la passion et le temps
a+