Discussion :

[tif04]

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

[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,

[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+

[casefayere]

Bonjour,

essayes ce fichier basé sur ton modèle et dis-moi tout

[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

[casefayere]

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 !

[Marc-L]

Ah toi aussi … Pour la peine !

[mercatog]

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.

[casefayere]

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 :

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
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 :

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
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

[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

[casefayere]

Bonjour ,le forum, 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 :

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
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 :

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
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 :

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 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

[casefayere]

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

quand tu écris

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

[mercatog]

C'est pas une course aux points mais ça reste un signe d'encouragement et de reconnaissance anonymes.

[tif04]

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!

[mercatog]

Bonsoir

Une proposition

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
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

[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