Résolu Macro VBA : Etendre le traitement a un nombre infini de feuilles

  • Auteur de la discussion seblkp
  • Date de début

seblkp

Habitué
Bonjour,

J'aimerais dire à VBA de réaliser un traitement pour TOUTES mes feuilles dont le nom commence par "BF-".

Mon traitement est le suivant, il est le même pour TOUTES mes feuilles :
Ligne 1 :
- Si Colonne B remplie, Alors copie B dans C de ma feuille de Récap
- Si Colonne B remplie, Alors copie C dans D de ma feuille de Récap
Ligne suivante
Si plus de ligne avec Colonne B remplie, Alors passe à la feuille suivante

Je vous ai écrit le traitement en format littéraire car je sais le réaliser seul avec VBA. J'ai juste besoin de ne pas avoir à "Dim" ni à "Set" l'intégralité de mes feuilles (Sachant qu'en plus de nouvelles seront ajoutées, et d'anciennes seront supprimées mensuellement). Mon point commun étant que TOUS les onglets (Feuilles) à analyser commencent tous par "BF-".

Merci beaucoup pour votre aide.

Seb
 

drul

Obscur pro du hardware
Staff
Meilleure réponse
Salut,

Voila comment parcourir toutes tes feuilles

Code:
Sub test()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets ' parcours toutes les feuille du classeurs
    If sh.Name Like "BF-*" Then 'Je t'invite à lire l'aide de la fonction "like", une vrai tuerie !
        'ton code de copie en utilisant "sh" comme source
    End If
Next
    
End Sub
 

seblkp

Habitué
Salut !

Merci pour ton retour :) Après plusieurs essais ca marche a merveille ! Et en effet la fonction Like ouvre plein de possibilités :o

Dans chaque "BF-" j'ai ma cellule C37 qui me donne le nombre de lignes occupées. Ca me permet de checker a chaque activation que la maccro a bien fonctionné et n'a pas ajouté ou supprimé des lignes. J'aimerais faire apparaitre dans mon Récap, le total de toutes les C37 présentes dans ces onglets.

Pour l'instant j'ai placé ma somme voulue comme ceci (Mon F1 correspond à ton sh) :

Code:
For Each F1 In ThisWorkbook.Sheets
If F1.Name Like "E-*" Then

R.Cells(2, "E").Value = F1.Cells(37, "C")

Comme je m'y attendais, la valeur qui apparait en E2 n'est que la valeur de C37 sur le dernier onglet "BF-*" parcouru

Merci pour ton aide :)

 

drul

Obscur pro du hardware
Staff
Pas bien compris ... tu veux la somme de toutes les c37 ?

Si c'est bien le cas :
Code:
R.Cells(2, "E").Value = R.Cells(2, "E").Value + F1.Cells(37, "C").Value 'n'oublie pas le ".value" stp risque de bug sinon

N.B. il est par contre important en début de macro de remettre ta cellule "E2" à 0 ...

P.S. je te montre une notation un peu plus compacte et lisible:
Code:
R.[E2].Value = R.[E2].Value + F1.[C37].Value


 

seblkp

Habitué
Parfait ca marche a merveille :)

Code:
R.Cells(2, "E").Value = 0
 
For Each F1 In ThisWorkbook.Sheets
If F1.Name Like "E-*" Then

R.Cells(2, "E").Value = R.Cells(2, "E").Value + F1.Cells(37, "C")

Je marque comme résolu :)
 

seblkp

Habitué
J'ai voulu combiner cette nouvelle maccro, avec la précédente, et j'ai un message d'erreur 404 qui apparait a chaque exécution.... 2h30 que j'essaye de trouver d'où ca vient et je n'y arrive pas... Tu peux jetter un oeil ?

En gros, dans un premier temps, F4 et F5 alimentent F3, puis dans un second temps, F1, F2 et F3 alimentent R.
(F6 ne sert qu'à donner un taux de conversion à deux reprises)
F1 et F2 sont dans un autre classeur. Tout le reste est sur le même.

Code:
Sub TotalAll()

Application.ScreenUpdating = False
 
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Dim F4 As Worksheet
Dim F5 As Worksheet
Dim F6 As Worksheet
Dim R As Worksheet
Dim RecapTargetRow

Dim i As Integer
RecapTargetRow = 5

Set F1 = Workbooks("Incomes & Outcomes").Worksheets("CREDIT")
Set F2 = Workbooks("Incomes & Outcomes").Worksheets("DEBIT")
Set F3 = Worksheets("SALARIES")
' F4 est l'ensemble des pages "E-*" à parcourir
' F5 est l'ensemble des pages "W-*" à parcourir
Set F6 = Worksheets("Workers")
Set R = Worksheets("Recap")
 
R.Range("B8:F500000").ClearContents
R.Range("H8:K500000").ClearContents

F3.Range("C5:F500000").ClearContents
F3.Range("H5:K500000").ClearContents
F3.Cells(2, "E").Value = 0
 
For Each F4 In ThisWorkbook.Sheets
If F4.Name Like "E-*" Then

For i = 5 To 5000
 
F3.Cells(2, "E").Value = F3.Cells(2, "E").Value + F4.Cells(37, "C").Value

    If F4.Cells(i, "H").Value <> "" Then
    
        If F4.Cells(i, "S").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F4.Cells(i, "S").Value
        F3.Cells(RecapTargetRow, "D").Value = F4.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F4.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F4.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F4.Cells(i, "K").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Fees"
        F3.Cells(RecapTargetRow, "K").Value = (F4.Cells(i, "T").Value) * (-1)
        RecapTargetRow = RecapTargetRow + 1
        End If
        
        If F4.Cells(i, "U").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F4.Cells(i, "U").Value
        F3.Cells(RecapTargetRow, "D").Value = F4.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F4.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F4.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F4.Cells(i, "K").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Payroll"
        F3.Cells(RecapTargetRow, "J").Value = (F4.Cells(i, "V").Value) * (-1)
        RecapTargetRow = RecapTargetRow + 1
        End If
        
        If F4.Cells(i, "W").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F4.Cells(i, "W").Value
        F3.Cells(RecapTargetRow, "D").Value = F4.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F4.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F4.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F4.Cells(i, "K").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Advances on Salaries"
        F3.Cells(RecapTargetRow, "K").Value = (F4.Cells(i, "X").Value) * (-1)
        RecapTargetRow = RecapTargetRow + 1
        End If
        
        If F4.Cells(i, "Y").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F4.Cells(i, "Y").Value
        F3.Cells(RecapTargetRow, "D").Value = F4.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F4.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F4.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F4.Cells(i, "K").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Due and Paid"
        F3.Cells(RecapTargetRow, "K").Value = (F4.Cells(i, "Z").Value) * (-1)
        RecapTargetRow = RecapTargetRow + 1
        End If
        
        If F4.Cells(i, "AA").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F4.Cells(i, "AA").Value
        F3.Cells(RecapTargetRow, "D").Value = F4.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F4.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F4.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F4.Cells(i, "K").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Expenses Claims"
        F3.Cells(RecapTargetRow, "K").Value = (F4.Cells(i, "AB").Value) * (-1)
        RecapTargetRow = RecapTargetRow + 1
        End If
    
    End If

Next

End If

Next

For Each F5 In ThisWorkbook.Sheets
If F5.Name Like "W-*" Then

For i = 5 To 5000

If F5.Cells(i, "H").Value <> "" Then

F3.Cells(2, "E").Value = F3.Cells(2, "E").Value + F5.Cells(37, "C").Value
    
        If F5.Cells(i, "T").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F5.Cells(i, "T").Value
        F3.Cells(RecapTargetRow, "D").Value = F5.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F5.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F5.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F5.Cells(i, "L").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Fees"
        F3.Cells(RecapTargetRow, "K").Value = (F5.Cells(i, "U").Value) * (-1) / (F6.Cells(2, "Q"))
        RecapTargetRow = RecapTargetRow + 1
        End If
        
        If F5.Cells(i, "V").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F5.Cells(i, "V").Value
        F3.Cells(RecapTargetRow, "D").Value = F5.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F5.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F5.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F5.Cells(i, "L").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Payroll"
        F3.Cells(RecapTargetRow, "J").Value = (F5.Cells(i, "W").Value) * (-1) / (F6.Cells(2, "Q"))
        RecapTargetRow = RecapTargetRow + 1
        End If
        
        If F5.Cells(i, "X").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F5.Cells(i, "X").Value
        F3.Cells(RecapTargetRow, "D").Value = F5.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F5.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F5.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F5.Cells(i, "L").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Advances on Salaries"
        F3.Cells(RecapTargetRow, "K").Value = (F5.Cells(i, "Y").Value) * (-1)
        RecapTargetRow = RecapTargetRow + 1
        End If
        
        If F5.Cells(i, "Z").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F5.Cells(i, "Z").Value
        F3.Cells(RecapTargetRow, "D").Value = F5.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F5.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F5.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F5.Cells(i, "L").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Due and Paid"
        F3.Cells(RecapTargetRow, "K").Value = (F5.Cells(i, "AA").Value) * (-1)
        RecapTargetRow = RecapTargetRow + 1
        End If
        
        If F5.Cells(i, "AB").Value <> "" Then
        F3.Cells(RecapTargetRow, "C").Value = F5.Cells(i, "AB").Value
        F3.Cells(RecapTargetRow, "D").Value = F5.Cells(2, "B").Value
        F3.Cells(RecapTargetRow, "E").Value = F5.Cells(4, "B").Value
        F3.Cells(RecapTargetRow, "F").Value = F5.Cells(i, "H").Value
        F3.Cells(RecapTargetRow, "H").Value = F5.Cells(i, "L").Value
        F3.Cells(RecapTargetRow, "I").Value = "OUT - Expenses Claims"
        F3.Cells(RecapTargetRow, "K").Value = (F5.Cells(i, "AC").Value) * (-1)
        RecapTargetRow = RecapTargetRow + 1
        End If
    
    End If

Next

End If

Next

F3.Range("C4:K3000").Select
    ActiveWorkbook.Worksheets("SALARIES").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SALARIES").Sort.SortFields.Add Key:=Range("C4:C3000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("SALARIES").Sort
        .SetRange Range("C4:K3000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

RecapTargetRow = 8
 
For i = 5 To 8000
 
    If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F1.Cells(i, "B").Value
        R.Cells(RecapTargetRow, "C").Value = F1.Cells(i, "C").Value
        R.Cells(RecapTargetRow, "D").Value = F1.Cells(i, "D").Value
        R.Cells(RecapTargetRow, "E").Value = F1.Cells(i, "J").Value
        R.Cells(RecapTargetRow, "F").Value = F1.Cells(i, "I").Value
        R.Cells(RecapTargetRow, "K").Value = F1.Cells(i, "N").Value
        If F1.Cells(i, "E").Value = "I" Then
        R.Cells(RecapTargetRow, "I").Value = F1.Cells(i, "M").Value
        End If
        If F1.Cells(i, "E").Value <> "I" Then
        R.Cells(RecapTargetRow, "J").Value = F1.Cells(i, "M").Value
        End If
        RecapTargetRow = RecapTargetRow + 1
    End If
 
Next
 
 
For i = 5 To 8000
 
    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F2.Cells(i, "B").Value
        R.Cells(RecapTargetRow, "C").Value = F2.Cells(i, "C").Value
        R.Cells(RecapTargetRow, "D").Value = F2.Cells(i, "D").Value
        R.Cells(RecapTargetRow, "E").Value = F2.Cells(i, "H").Value
        R.Cells(RecapTargetRow, "F").Value = F2.Cells(i, "G").Value
        R.Cells(RecapTargetRow, "H").Value = F2.Cells(i, "J").Value
        R.Cells(RecapTargetRow, "K").Value = F2.Cells(i, "M").Value
        If F2.Cells(i, "E").Value = "I" Then
        R.Cells(RecapTargetRow, "I").Value = (F2.Cells(i, "L").Value) * (-1)
        End If
        If F2.Cells(i, "E").Value <> "I" Then
        R.Cells(RecapTargetRow, "I").Value = (F2.Cells(i, "L").Value) * (-1)
        End If
        RecapTargetRow = RecapTargetRow + 1
    End If
    
Next

For i = 5 To 8000
 
    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F3.Cells(i, "B").Value
        R.Cells(RecapTargetRow, "C").Value = F3.Cells(i, "F").Value
        R.Cells(RecapTargetRow, "D").Value = F3.Cells(i, "C").Value
        R.Cells(RecapTargetRow, "E").Value = F3.Cells(i, "H").Value
        R.Cells(RecapTargetRow, "F").Value = F3.Cells(i, "G").Value
        R.Cells(RecapTargetRow, "H").Value = F3.Cells(i, "E").Value
        R.Cells(RecapTargetRow, "K").Value = F3.Cells(i, "I").Value
        R.Cells(RecapTargetRow, "I").Value = F3.Cells(i, "J").Value
        R.Cells(RecapTargetRow, "J").Value = F3.Cells(i, "K").Value
        RecapTargetRow = RecapTargetRow + 1
    End If

Next
 
R.Range("B7:K500000").Select
    ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Add Key:=Range("D7:D500000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Recap").Sort
        .SetRange Range("B7:K500000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
Set F1 = Nothing
Set F2 = Nothing
Set F3 = Nothing
Set F6 = Nothing
Set R = Nothing

Application.ScreenUpdating = True
    
End Sub

Merci :)
 

drul

Obscur pro du hardware
Staff
essaie de supprimer ces 2 lignes:

F3.Range("C4:K3000").Select
...
R.Range("B7:K500000").Select
 

drul

Obscur pro du hardware
Staff
Tu ne peux pas sélectionner une range si la feuille n'est pas active, c'est pour cela que ça plantait. En l’occurrence il était inutile de sélectionner la plage un héritage de l'enregistreur de macro je suppose.
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 101
Membres
1 586 287
Dernier membre
lucilleguffey
Partager cette page
Haut