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

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

seblkp

Habitué
Bonjour !



Bonjour !

Dans le cadre d'un projet professionnel je dois réaliser des classeurs Excel interdépendants. Je manie très bien excel mais j'ai beaucoup de lacunes avec VBA et il me semble que mon problème ne peut pas se résoudre autrement...

----------

J'ai 5 feuilles primaires (notons les "P") de data. Ces feuilles vont être alimentées quotidiennement et manuellement à l'avenir.
Ces 5 feuilles doivent être triées et réorganisées en permanence pour alimenter automatiquement 2 nouvelles feuilles de récapitulation (Appelons les "R").
Chaque nouvelle entrée correspond à une ligne, et 7, 8 ou 9 colonnes (Les structures des feuilles P ne sont pas exactement les mêmes). Le principe est de copier entièrement les lignes dans les feuilles récap si elles sont complétées correctement.

----------

Mon problème réside dans le fait que j'ai besoin que mes tableau R soient triés dans l'ordre dans lequel les lignes ont été complétées parmi toutes mes 5 feuilles P. Aussi, je ne veux pas de ligne vide dans R.

----------

Ce sont des tableaux de saisie de données comtpables. Mes feuilles primaires étant Les débits (P1), les crédits (P2), les acomptes en débit (P4), les acomptes en crédit (P5) et les salaires (P3).

Mes feuilles R étants un tableau de FACTURATION et un tableau de TRESORERIE.

Vous comprennez bien que j'ai besoin de précision car ce sont ces tableaux finaux qui serviront à faire un suivi régulier des opérations de mon entreprise.

----------

- Feuille P1 : Si ma colonne K est remplie, la ligne se copie entièrement dans la feuille R1, si non, elle ne se copie pas. Si ma colonne L est remplie, la ligne se copie entièrement dans la feuille R2, si non, elle ne se copie pas. Si les deux clonnes K et L sont remplies, elles se copient à la foi dans R1 et R2.
(K correspondant a la facturation et L à la trésorerie)

- Feuille P2 : Même principe que la feuille P1 sauf que les colonnes sont I et J (I alimente R1 et J alimente R2)
- Feuille P3 : Même principe que les feuilles P1 et P2, les colonnes sont I et J également.

- Feuilles P4 & P5 : Ces feuilles n'alimenteront que la feuille R2 (Trésorerie), si les colonnes H (pour P3) et I (pour P4) sont remplies, sinon la ligne ne se copie pas.

----------

Merci beaucoup pour votre aide !

Seb
 

drul

Obscur pro du hardware
Staff
Salut, tjrs d'actu ?
Une piste, une base une idée ?
Ici on ne fera pas le boulot à ta place, mais on peut t'aider à y arriver ...

Edit: donc toujours d'actu :D !
 

seblkp

Habitué
Salut,

Etant donné que je ne connais rien en VBA j'essaye actuellement de régler mon problème simplement avec des formules Excel. Mon principal problème étant de réussir a reporter que certaines lignes sur mes tableaux finaux.

Je suis en train d'associer un code pour chaque ligne de chaque tableau primaire (P1-0001; P1-0002, P3-0004, P5-0002....) pour les renvoyer toutes par odre de date dans un nouveau tableau intermédiaire, que je retrierais ensuite pour former mes tableaux finaux...

Je ne sais pas si cela va marcher mais la piste me semble prometteuse.

Qu'en pense tu ?

Merci pour ton retour
 

drul

Obscur pro du hardware
Staff
Je suis plus expert VBA que excel ... mais ça me semble possible ...
 

seblkp

Habitué
Ma solution ne me parait pas être viable...

Comment dire à VBA :

Sub Regroup_Data()

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

- Pour chaque ligne dans les feuilles 1, 2, 3, 4 et 5 (De la ligne 5 jusqu'à la ligne 500)
- Si colonne B est non nulle
- Alors copie la valeur en colonne B dans la ligne correspondante, colonne B de "Recap"
- Alors copie la valeur en colonne D dans la ligne correspondante, colonne E de "Recap"
- Alors copie la valeur en colonne E dans la ligne correspondante, colonne F de "Récap"
- Tries toutes les lignes apparentes dans "Recap", par ordre de Date.

End Sub.

(Je pense qu'il faut dire à VBA de dabord faire les pages une par une, en les échainant avec des "Next", puis de faire un tri global a la fin...)

Je pense que si j'arrive à trouver ça, je peux me débrouiller seule par la suite sur cette base.

Merci pour ton aide !
 

drul

Obscur pro du hardware
Staff
Meilleure réponse
ça j'aime !
Très bon début

Commençons avec Feuille1 ...

Code:
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 i As Integer
RecapTargetRow = 1 'on commence à remplir la feuille recap depuis la ligne 1.
'on affect ta variable Feuille_1 et Recap
Set Feuille_1 = Worksheets("nom de la feuille 1") 'met le VRAI nom de ta feuille ici
Set Recap = Worksheets("nom de la feuille Recap") 'met le VRAI nom de ta feuille ici

' Pour chaque ligne dans la feuilles 1 (De la ligne 5 jusqu'à la ligne 500)
For i = 5 To 500 'une boucle sur 500 ligne '(totallement inefficace, on pourrait déterminer le nombre de ligne a checker ... mais c'est du niveau 2.
    'Si colonne B est non nulle
    If Feuille_1.Cells(i, "B").Value <> "" Then
        'on copie la cellule dans recap
        Recap.Cells(RecapTargetRow, "B").Value = Feuille_1.Cells(i, "B").Value
    End If
    
    'ici je te laisse essayer colonne 1D et E
    
    RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap
Next

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

End Sub

N.B. la macro suppose que recap est vide au démarrage (c'est automatisable),
on rempli recap depuis la ligne 1.
Plein de chose pourrait être optimisé pour la rapidité d'execution, mais c'est pas le but actuel.
Je t'ai laisser un peu de boulot ...
 

seblkp

Habitué
J'ai dans un premier temps essayé de déclarer toutes mes variables à Excel, puis d'essayer une simple copie des données colonne B de la feuille 1 (Nommée CREDITS) dans la colonne B de la feuille Recap.

Je saurais reproduire la mise en forme dès que ma maccro sera juste.

J'ai un problème au niveau du "For Each Line"

Avez vous une idée ?

Code:
Sub Enregistrement()

Dim CREDIT As Worksheet
Dim Down_Payments_CREDITS As Worksheet
Dim DEBIT As Worksheet
Dim Down_Payments_DEBITS As Worksheet

Dim Recap As Worksheet

Dim ID As String
Dim Dat As String
Dim Struct As Integer
Dim Invoice As String
Dim SecondPart As String
Dim AmountBill As Double
Dim AmountPaid As Double

Dim Line As Integer
Line = 5

For Each Line In CREDIT
Do While Cells(Line, 2) <> ""
Range("Line, 2").Select
Selection.Copy
Worksheets(Recap).Range("Line, 2").Select
Selection.Paste

Next Line

End Sub


Merci
 

drul

Obscur pro du hardware
Staff
Salut, pas mal d'erreur en 5 lignes ... pas facile au début le VBA ...

----------------------------------------------------------------------------

Code:
For Each Line In CREDIT
"For each" est un peu tricky, je te conseille d'en rester comme sur mon exemple à "For Next"
Ensuite, VBA n'a aucune idée de ce qu'est "CREDIT", pour c'est une variable de type worksheet non initialisée (regarde la aussi mon exemple ci-dessus)

----------------------------------------------------------------------------

Code:
Do While Cells(Line, 2) <> ""
Mauvais choix, ce n'est pas un while qu'il faut faire, mais un "If" (tu boucles déjà avec for ...)
En plus qu'en on travail sur plusieurs feuille, il toujours introduire la ref complète d'une cellule (sinon excel prend la feuille active), donc:
CREDIT.Cells(line, 2).Value <>"" (il est préférable de mettre le ".value, même si c'est optionnel)

----------------------------------------------------------------------------

Code:
Range("Line, 2").Select
Selection.Copy
Worksheets(Recap).Range("Line, 2").Select
Selection.Paste
QQ erreurs de syntaxe et inutilement complexe (machin.select + selection.copy = machin.copy ...)
donc en résumé on peut juste écrire:
CREDIT.Cells(line,2).copy Sheets("Recap").cells(???, 2)

N.B. les ??? représente la ligne sur laquelle tu veux copier tes donnée et qui n'est évidement pas égale à Line (sinon tu auras plein de trou et de problème quand tu travailleras sur plusieurs feuilles ...)
Une fois de plus regarde l'exemple que j'ai donné ci-dessus.


 

globulle93

Habitué
bonjour
pour copier privilégie le "copie destination" que le copier coller qu'on fait dans excel.

 

seblkp

Habitué
Salut,

Voici où j'en suis !
Code:
Sub test()

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 i As Integer
RecapTargetRow = 5 'on commence à remplir la feuille recap depuis la ligne 5 => 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 R = Worksheets("Recap") 'met le VRAI nom de ta feuille ici => OK
 
' Pour chaque ligne dans la feuille 1 (De la ligne 5 jusqu'à la ligne 500) => OK
For i = 5 To 500 'une boucle sur 500 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...

    'Si colonne B est non nulle => OK
    If F1.Cells(i, "B").Value <> "" Then
        'on copie la cellule dans recap => OK
        Recap.Cells(RecapTargetRow, "B").Value = F1.Cells(i, "B").Value
    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
        Recap.Cells(RecapTargetRow, "C").Value = F1.Cells(i, "C").Value
    End If
    
'SEB => De D à D
    If F1.Cells(i, "B").Value <> "" Then
        Recap.Cells(RecapTargetRow, "D").Value = F1.Cells(i, "D").Value
    End If

'SEB => De H à E
    If F1.Cells(i, "B").Value <> "" Then
        Recap.Cells(RecapTargetRow, "E").Value = F1.Cells(i, "H").Value
    End If
    
'SEB => De I à F
    If F1.Cells(i, "B").Value <> "" Then
        Recap.Cells(RecapTargetRow, "F").Value = F1.Cells(i, "I").Value
    End If
    
'SEB => De J à G
    If F1.Cells(i, "B").Value <> "" Then
        Recap.Cells(RecapTargetRow, "G").Value = F1.Cells(i, "J").Value
    End If
    
'SEB => De L à H
    If F1.Cells(i, "B").Value <> "" Then
        Recap.Cells(RecapTargetRow, "H").Value = F1.Cells(i, "L").Value
    End If
    
'SEB => De M à I
    If F1.Cells(i, "B").Value <> "" Then
        Recap.Cells(RecapTargetRow, "I").Value = F1.Cells(i, "M").Value
    End If
 
RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap => OK
    
Next
 
' pour le tri, je t'invite a essayer l'enregistreur de macro. => OK
 
End Sub
La macro me renvoi une erreur 424, comment l'expliquer ?

Merci pour ton aide !
 

drul

Obscur pro du hardware
Staff
Mais des points d'arret (F9) et essaye du pas a pas (F8) pour trouver ou ca plante exactement.
 

globulle93

Habitué
moi j'aurais plutôt mis du case au lieu du if la.

ça devient lourd tout les if on dit souvent que passé 3 if il vaut mieux aller vers du case

ca donne ca le calcul de ligne rempli

Code:
finalrow = WSD.Cells(Rows.Count, 1).End(xlUp).Row

wsd = nom de variable worksheet

il compte les ligne rempli et ne vas pas après
 

drul

Obscur pro du hardware
Staff
Sauf que les if sont faux ...
La conditions change à chaque fois, pas possible un case dans ces conditions. (mais il a toujours laisser "B" au lieu de changer de colonne)

Edit: Tiens la variable de ta feuille Recap s'appelle "R", mais dans le code tu utilises Recap, une bonne piste pour 424 ...
Pour éviter ce genre de problem tu peux rajouter avant le sub:
Code:
Option Explicit
sub ....
Ceci impose la déclaration de variable, et aide au debug

@ Globulle, tu vas un peu vite pour un novice là, même si en effet c'est une bonne méthode pour déterminer la longueur de la plage à tester
 

globulle93

Habitué
il voulait savoir :D
j'ai commencé comme lui et sur tes conseil j'ai avancé.
Maintenant je fais vba pour un maximum de chose avec en bonus les interfaces :lol:
il m'arrive même de plus savoir le faire avec les fonctions simple d'excel
:/

je suis surpris drul que tu n'ai pas rebondi sur les balises :lol:
 

drul

Obscur pro du hardware
Staff
Je me fais vieux ..., mais ok:
@seblkp: stp mais ton code entre balise [code="vb"] .... ton code ... [/code] ça fait des jolies couleurs, et surtout ça évite les smileys au milieu du code ;)

re@Globulle Je crois pas que c'est lui qui voulait savoir, mais plutôt un commentaire que j'avais mis moi ...
 

seblkp

Habitué
Merci Drul ! En effet l'erreur 424 venait de mes Recap que j'ai donc transformé en R !
Tout fonctionne donc comme prévu pour la Feuille 1 :)

Pour la structure de la Feuille 2, je sais comment faire, mais comment dire à VBA de le mettre a la suite de ce qu'il a déjà dans Récap ?

Je vais essayer des trucs, je reviens vers toi si je ne trouve pas.

En attendant, je suis très intéréssé par la solution de @globulle93, pouvez vous m'en dire plus ?

Merci beaucoup pour tout !
 

seblkp

Habitué
Je ne trouve pas :( J'ai rajouté toute la structure pour extraire les données depuis la F2, mais lorsque je lance la macro, il ne me fait le travail que sur la feuille 1. Je t'ai mis en ROUGE là ou je pense qu'il me manque quelquechose.

Code:
Sub test()

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 i As Integer
RecapTargetRow = 5 'on commence à remplir la feuille recap depuis la ligne 5 => 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
 
' Pour chaque ligne dans la feuille 1 (De la ligne 5 jusqu'à la ligne 500) => OK
For i = 5 To 500 'une boucle sur 500 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...

    '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
    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
 
RecapTargetRow = RecapTargetRow + 1 ' on pointe la ligne suivante dans récap => OK
    
[color=#e1333b][b]Next

For i = 5 To 500[/b][/color]

    If F2.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "B").Value = F2.Cells(i, "B").Value
    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

RecapTargetRow = RecapTargetRow + 1
    
Next

End Sub
 

seblkp

Habitué
Ahhhh j'ai compris ! Il m'a mis les données de ma feuille 2, à partir de la ligne 500 du coup...

Je pense que l'indication de @Globulle s'impose, il faut que RecapTargetRow s'arrête là ou il n'y a plus de ligne en F1 et ainsi de suite
 

seblkp

Habitué
Quelquechose comme ceci sinon ?

Code:
'Fin de la partie dédiée à la feuille 1

    If F1.Cells(i, "B").Value <> "" Then
        R.Cells(RecapTargetRow, "I").Value = F1.Cells(i, "M").Value
    End If
 
'Eventuelle solution à envisager ?

    If F1.Cells(i + 1, "B").Value = "" Then Stop
    End If
    
RecapTargetRow = RecapTargetRow + 1
    
Next

'Début de la partie sur la feuille 2

For i = 5 To 500

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

'To be continued...

 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 128
Messages
6 717 850
Membres
1 586 373
Dernier membre
https://forum.tomshardwar
Partager cette page
Haut