Résolu Création d'un macro VBA (I need help :( )

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

drul

Obscur pro du hardware
Staff
Salut, alors effectivement il manque un truc ...
Il faut incrémenter RecapTargetRow seulement s'il y a eu une copie sur cette ligne ... Pour cela le plus simple est de créer une variable
Code:
Option Explicit
Sub test()
Dim Feuille_1 As Worksheet
Dim Feuille_2 As Worksheet
Dim Feuille_3 As Worksheet
Dim Feuille_4 As Worksheet
Dim Feuille_5 As Worksheet
Dim Recap As Worksheet
Dim RecapTargetRow
Dim NewLine

'....

For i = 5 To 500
        NewLine = False 'on evalue une nouvelle ligne, donc on réinitialise le flag

    If Feuille_1.Cells(i, "B").Value <> "" Then

        Recap.Cells(RecapTargetRow, "B").Value = Feuille_1.Cells(i, "B").Value
        NewLine = True 'On a copier des données donc il faudra une nouvelle ligne dans target
    End If
    
    If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
        RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
    End If

Next

' pour le tri, je t'invite a essayer l'enregistreur de macro.

End Sub

Pour faire plusieurs feuilles à la suite, je vois 3 solutions:
1) la mauvaise: copier tout le code pour chaque feuille
2) Remplacer F1, F2, F3, ... par un tableau de feuille F(n) et boucler sur ce tableau
3) Effectuer la boucle for i=5 to 500 dans une sous-fonction, que tu appelleras pour chaque feuille
3bis) Mixer la 2 et la 3 ...
 

seblkp

Habitué
Merci tu es au top ! Je te laisse ma maccro terminée afin que tu vois tes talents de prof de progra ;)

Ton code pour enchainer les tableaux marche a merveille + j'ai également rajouté un reset total de Recap au début (Histoire de ne pas faire d'erreurs) + j'ai réussi a faire passer mes valeurs de F3, F4 et F5 en négatif + j'ai réussi a faire le tri à la fin ;)

Merci encore pour ton aide ! Tu peux mettre le sujet en tant que résolu :)

Code:
Sub Import()

Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Dim F4 As Worksheet
Dim F5 As Worksheet
Dim R As Worksheet
Dim RecapTargetRow
Dim NewLine
 
Dim i As Integer
RecapTargetRow = 8 'on commence à remplir la feuille recap depuis la ligne 7 => OK

'SEB => A noter qu'ici il faudra que RecapTargetRow soit égal à la ligne+1 à laquelle il aura fini de copier le tableau 1 avant de copier le tableau 2.

'on affect ta variable Feuille_1 et Recap => OK
Set F1 = Worksheets("CREDIT") 'met le VRAI nom de ta feuille ici => OK
Set F2 = Worksheets("Down_Payments_CREDIT")
Set F3 = Worksheets("DEBIT")
Set F4 = Worksheets("Down_Payments_DEBIT")
Set F5 = Worksheets("SALARIES")
Set R = Worksheets("Recap") 'met le VRAI nom de ta feuille ici => OK
 
R.Range("B8:J500000").Select
Selection.ClearContents
' Pour chaque ligne dans la feuille 1 (De la ligne 5 jusqu'à la ligne 500) => OK
For i = 5 To 50 'une boucle sur 50 ligne '(totallement inefficace, on pourrait déterminer le nombre de ligne a checker ... mais c'est du niveau 2. => OK
'SEB => Je suis intéréssé si ca peut faire gagner du temps ! Il faudrait qu'il s'arrête à la première ligne vide qu'il détecte en fait...

NewLine = False

    'Si colonne B est non nulle => OK
    If F1.Cells(i, "B").Value <> "" Then
        'on copie la cellule dans recap => OK
        R.Cells(RecapTargetRow, "B").Value = F1.Cells(i, "B").Value
        NewLine = True
    End If
 
'ici je te laisse essayer colonne D et E => OK J'ESSAYE :)
'SEB => De C à C
    If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "C").Value = F1.Cells(i, "C").Value
    End If
    
'SEB => De D à D
    If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "D").Value = F1.Cells(i, "D").Value
    End If

'SEB => De H à E
    If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "E").Value = F1.Cells(i, "H").Value
    End If
    
'SEB => De I à F
    If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "F").Value = F1.Cells(i, "I").Value
    End If
    
'SEB => De J à G
    If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "G").Value = F1.Cells(i, "J").Value
    End If
    
'SEB => De L à H
    If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "H").Value = F1.Cells(i, "L").Value
    End If
    
'SEB => De M à I
    If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "I").Value = F1.Cells(i, "M").Value
    End If
    
'SEB => De N à J
     If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "J").Value = F1.Cells(i, "N").Value
    End If
    
If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
        RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
End If
    
Next

'F2

For i = 5 To 50

NewLine = False

    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F2.Cells(i, "B").Value
        NewLine = True
    End If

    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "C").Value = F2.Cells(i, "C").Value
    End If
    
    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "D").Value = F2.Cells(i, "D").Value
    End If

    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "E").Value = F2.Cells(i, "F").Value
    End If
    
    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "F").Value = F2.Cells(i, "E").Value
    End If
    
    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "G").Value = F2.Cells(i, "G").Value
    End If
    
    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "I").Value = F2.Cells(i, "I").Value
    End If
    
    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "J").Value = F2.Cells(i, "K").Value
    End If

If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
        RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
End If

Next

'F3

For i = 5 To 50

NewLine = False

    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F3.Cells(i, "B").Value
        NewLine = True
    End If

    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "C").Value = F3.Cells(i, "C").Value
    End If
    
    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "D").Value = F3.Cells(i, "D").Value
    End If

    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "E").Value = F3.Cells(i, "H").Value
    End If
    
    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "F").Value = F3.Cells(i, "F").Value
    End If
    
    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "G").Value = F3.Cells(i, "E").Value
    End If
    
    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "H").Value = (F3.Cells(i, "J").Value) * (-1)
    End If
    
    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "I").Value = (F3.Cells(i, "K").Value) * (-1)
    End If
    
    If F3.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "J").Value = F3.Cells(i, "L").Value
    End If

If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
        RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
End If
    
Next

'F4

For i = 5 To 50

NewLine = False

    If F4.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F4.Cells(i, "B").Value
        NewLine = True
    End If

    If F4.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "C").Value = F4.Cells(i, "C").Value
    End If
    
    If F4.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "D").Value = F4.Cells(i, "D").Value
    End If

    If F4.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "E").Value = F4.Cells(i, "H").Value
    End If
    
    If F4.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "F").Value = F4.Cells(i, "F").Value
    End If
    
    If F4.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "G").Value = F4.Cells(i, "E").Value
    End If
    
    If F4.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "I").Value = (F4.Cells(i, "J").Value) * (-1)
    End If
    
    If F4.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "J").Value = F4.Cells(i, "K").Value
    End If
    
If NewLine Then 'si on a copier des données, alors on pointe sur une nouvelle ligne dans Reacap
        RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
End If
    
Next

'F5

For i = 5 To 50

    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F5.Cells(i, "B").Value
    End If

    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "C").Value = F5.Cells(i, "C").Value
    End If
    
    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "D").Value = F5.Cells(i, "D").Value
    End If

    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "E").Value = F5.Cells(i, "F").Value
    End If
    
    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "F").Value = F5.Cells(i, "I").Value
    End If
    
    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "G").Value = F5.Cells(i, "E").Value
    End If
    
    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "H").Value = (F5.Cells(i, "J").Value) * (-1)
    End If
    
    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "I").Value = (F5.Cells(i, "K").Value) * (-1)
    End If
    
    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "J").Value = "Salaries"
    End If
    
RecapTargetRow = RecapTargetRow + 1
    
Next

R.Range("B7:J500000").Select
    ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Add Key:=Range("D8:D500000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Recap").Sort
        .SetRange Range("B7:J500000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub
 

drul

Obscur pro du hardware
Staff
Juste un truc ...
Tes if ont tous la même conditions ... c'est normal ? (je m'attendais à voir "C", "D", ... pour les 2eme, 3eme, .... if's

Sinon:
R.Range("B8:J500000").Select
Selection.ClearContents

s'écrit plutôt:
R.Range("B8:J500000").ClearContents

P.S. seul toi, ou un autre admin à la moyen de choisir un meilleur réponse pour clore le sujet ...
 

seblkp

Habitué
En fait la collonne B est un code (ID de transaction/ligne) que j'ai crée a partir de formules Excel :)

Le code ne s'affiche en B que si les autres colonnes sont toutes remplies ! Donc si il y a B, il y a le reste ;)

Merci pour le tips ;)

A une prochaine !
 

seblkp

Habitué
Après modifications :) :

Code:
Sub Import()

Dim F1 As Worksheet
Dim F2 As Worksheet
Dim F3 As Worksheet
Dim F4 As Worksheet
Dim F5 As Worksheet
Dim R As Worksheet
Dim RecapTargetRow
Dim NewLine
 
Dim i As Integer
RecapTargetRow = 8

Set F1 = Worksheets("CREDIT")
Set F2 = Worksheets("Down_Payments_CREDIT")
Set F3 = Worksheets("DEBIT")
Set F4 = Worksheets("Down_Payments_DEBIT")
Set F5 = Worksheets("SALARIES")
Set R = Worksheets("Recap")
 
R.Range("B8:J500000").ClearContents

For i = 5 To 8000
NewLine = False

    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, "H").Value
        R.Cells(RecapTargetRow, "F").Value = F1.Cells(i, "I").Value
        R.Cells(RecapTargetRow, "G").Value = F1.Cells(i, "J").Value
        R.Cells(RecapTargetRow, "H").Value = F1.Cells(i, "L").Value
        R.Cells(RecapTargetRow, "I").Value = F1.Cells(i, "M").Value
        R.Cells(RecapTargetRow, "J").Value = F1.Cells(i, "N").Value
        NewLine = True
    End If
    
    If NewLine Then
        RecapTargetRow = RecapTargetRow + 1
    End If
    
Next


For i = 5 To 8000
NewLine = False

    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, "F").Value
        R.Cells(RecapTargetRow, "F").Value = F2.Cells(i, "E").Value
        R.Cells(RecapTargetRow, "G").Value = F2.Cells(i, "G").Value
        R.Cells(RecapTargetRow, "I").Value = F2.Cells(i, "I").Value
        R.Cells(RecapTargetRow, "J").Value = F2.Cells(i, "K").Value
        NewLine = True
    End If

    If NewLine Then
        RecapTargetRow = RecapTargetRow + 1
    End If

Next

For i = 5 To 8000
NewLine = False

    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, "C").Value
        R.Cells(RecapTargetRow, "D").Value = F3.Cells(i, "D").Value
        R.Cells(RecapTargetRow, "E").Value = F3.Cells(i, "H").Value
        R.Cells(RecapTargetRow, "F").Value = F3.Cells(i, "F").Value
        R.Cells(RecapTargetRow, "G").Value = F3.Cells(i, "E").Value
        R.Cells(RecapTargetRow, "H").Value = (F3.Cells(i, "J").Value) * (-1)
        R.Cells(RecapTargetRow, "I").Value = (F3.Cells(i, "K").Value) * (-1)
        R.Cells(RecapTargetRow, "J").Value = F3.Cells(i, "L").Value
        NewLine = True
    End If

    If NewLine Then
        RecapTargetRow = RecapTargetRow + 1
    End If
    
Next

For i = 5 To 8000
NewLine = False

    If F4.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F4.Cells(i, "B").Value
        R.Cells(RecapTargetRow, "C").Value = F4.Cells(i, "C").Value
        R.Cells(RecapTargetRow, "D").Value = F4.Cells(i, "D").Value
        R.Cells(RecapTargetRow, "E").Value = F4.Cells(i, "H").Value
        R.Cells(RecapTargetRow, "F").Value = F4.Cells(i, "F").Value
        R.Cells(RecapTargetRow, "G").Value = F4.Cells(i, "E").Value
        R.Cells(RecapTargetRow, "I").Value = (F4.Cells(i, "J").Value) * (-1)
        R.Cells(RecapTargetRow, "J").Value = F4.Cells(i, "K").Value
        NewLine = True
    End If
    
    If NewLine Then
        RecapTargetRow = RecapTargetRow + 1
    End If
    
Next

For i = 5 To 8000

    If F5.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F5.Cells(i, "B").Value
        R.Cells(RecapTargetRow, "C").Value = F5.Cells(i, "C").Value
        R.Cells(RecapTargetRow, "D").Value = F5.Cells(i, "D").Value
        R.Cells(RecapTargetRow, "E").Value = F5.Cells(i, "F").Value
        R.Cells(RecapTargetRow, "F").Value = F5.Cells(i, "I").Value
        R.Cells(RecapTargetRow, "G").Value = F5.Cells(i, "E").Value
        R.Cells(RecapTargetRow, "H").Value = (F5.Cells(i, "J").Value) * (-1)
        R.Cells(RecapTargetRow, "I").Value = (F5.Cells(i, "K").Value) * (-1)
        R.Cells(RecapTargetRow, "J").Value = "Salaries"
    End If
    
        RecapTargetRow = RecapTargetRow + 1
    
Next

R.Range("B7:J500000").Select
    ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Recap").Sort.SortFields.Add Key:=Range("D8:D500000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Recap").Sort
        .SetRange Range("B7:J500000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub
 

drul

Obscur pro du hardware
Staff
Ok, encore 2 trucs ...
1) newline sert plus a rien ... Tu peux glisser le "RecapTargetRow = RecapTargetRow + 1" directement dans le if
2) ta dernière boucle n'utilise pas newline, ça risque de te créer des trous dans recap. (donc en gros mets aussi "RecapTargetRow = RecapTargetRow + 1" dans le if ...)
 

globulle93

Habitué
encore heureux que les pc on de la mémoire maintenant car avec du i = 5 To 8000 et du R.Range("B7:J500000").Select

tu n'a pas typé ton RecapTargetRow et ton NewLine il est toujours préférable de le faire pour éviter les problèmes.

typé et initialisé évite des problèmes.

en fin de vba tes set il est toujours bien de les fermer

Set F1 = nothing
etc ..

Application.ScreenUpdating = False au début de macro et Application.ScreenUpdating = True en fin te permet d’accéléré ton traitement car a chaque fois sinon excel refresh ton écran.
 

seblkp

Habitué
Merci pour tes infos drul, et merci pour les tips globulle :) !

J'ai mis autant de sélection car je ne sais pas comment dire "Jusqu'à ce que tu trouves de la data"
Code:
for i = 5 to ?

Et pareil pour la sélection, c'est un condensé de F1 à F5 donc je ne sais pas combien de lignes il y aura au total



 

drul

Obscur pro du hardware
Staff
La fonction cells(rows.count,"une colonne").end(xlUp) te permet de trouver la dernière cellule occupé d'une colonne ...
En prenant cells(rows.count,"une colonne").end(xlUp).row, tu obiendras le num de la dernière ligne a traiter ... (la difficulté est de savoir quel colonne utilisé (ici, je dirais que "B" est un bon choix) ...
 

seblkp

Habitué
Salut Drul ! Désolé réponse tardive, je n'ai pas reçu de notification me disant que tu m'avais fait un retour...

Je vais essayer d'adapter ta formule à ma maccro :) Merci !

Parlons d'une NOUVELLE maccro maintenant :

Le principe est le même, récapituler plusieurs feuilles dans une seule appelée Recap. Ici ce sera un Récap "Salaires".

Points communs :
- Basé sur le fait que la colonne B est remplie.
- Prends le nombre de lignes remplies.

Différences :
- Il pourra y avoir plus de 500 feuilles, et non plus 5 comme dans la précédente maccro.
- Toutes mes feuilles sont identiques, donc je n'ai plus besoin de changer les colonnes pour chaque feuille et je peux associer le même traitement à toutes.

Question :
- Comment dire à VBA "Pour chaque onglet dont le nom commence par "BF-", fais moi le traitement {XXXX}" (Grace a toi je pense pouvoir mettre en place le traitement tout seul)

Le système de Maccro a 5 feuilles que j'avais crée au départ se révèle nécessiter beaucoup plus de complexité... Les 500+ feuilles ici sont les fiches "employé" de l'entreprise (Il n'y en a pas 500 mais je prends de la marge, d'où l'utilité du "Si l'onglet commence par "BF-"), et cette nouvelle page Récap salaires, sera prise en compte dans la précédente macro que j'ai réalisé avec ton aide. Cette nouvelle feuille "Récap Salaires" est donc un intermédiaire entre tous les salariés et ma page récap globale.

Merci beaucoup pour ton retour !
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 060
Membres
1 586 285
Dernier membre
LeFront
Partager cette page
Haut