Construire une macro complexe

Bonjour à tous,

Je peux dire que je suis débutant dans la programmation Excel, j'en ai un peu fait sous Access mais ça remonte un loin.

Voilà, je suis entrain de créer un classeur pour mon boulot et je rencontre de très grande difficulté dans ce que je veux faire.

Donc voilà, j'essai de construire une macro automatique pour remplir différents tableaux. Il y a un tableau par feuille.

Dans la feuille "Validation BC", quand je saisie une date dans la colonne "Date du BC", je voudrais déplacé certaines données. Je voudrais effectivement que le "N° du bon de commande" et le "Libellé de commande" soit déplacer dans la deuxième feuille "Edition du BC".

Après je pense que je pourrais faire le reste. Sauf l'élément le plus important qui est que quand je saisie une ligne dans n'importe quel tableau sur les cinq premières feuilles, cela remplisse aussi automatiquement la feuille "Synthese en cours".

J'espère être un peu clair dans mes explications.

Donc j'ai commencé à écrire ce qui suit en macro :

Sub DEPLACEMENT1()

Dim derlign As Long, i&, lignVide&

Sheets("VALIDATION BC").Activate

If Range("O" & i) <> "" Then

Sheets("EDITION BC").Activate

For i = 5 To Range("A" & Rows.Count).End(xlUp).Row

Sheets("VALIDATION BC").Range("C").Copy = Range("A")

Sheets("VALIDATION BC").Range("D").Copy = Range("B")

End Sub

Je ne sais pas si je suis sur la bonne voie.

Je vous remercie pour toute l'aide que vous pourrais me fournir pour comprendre le code de la macro.

Cordialement.

bonjour,

Déjà tu vas avoir rapidement des problèmes avec tes entêtes de colonnes sur 2 lignes (Analytique... Mandats...)

A bannir. Mets tous tes entêtes sur 1 seule ligne. Voir modèle "Synthèse effectuée")

Après on verra...

Tu n'as quand même pas oublié que un If ...Then attend un End If

De même entrer dans une boucle For... suppose un Next quelque part...

Enfin Range(A, B, C) n'existe pas ! Cest :

Range("A1")

Range("A2")

Ou dans une boucle :

Range("A" & i).Copy Range("C" & i)

Mais on reparlera de ça quand tu auras rectifié tes en-têtes et rajouté une ou 2 lignes de données à Copier / Coller...

A+

Merci,

J'ai apporter les corrections que tu m'as indiqué.

C'est surtout que je ne me souvient plus de comment on prends la valeur des cellules d'une feuille et les placées dans une autre. Je pense que c'est a peu près le code que pour Access.

Voici le tableur.

Bon, mais là tu me fais une salade méli-mélo !

Il y a un If qui vient un peu comme des cheveux sur la soupe... Au moment ou tu lances le If, le i n'est pas encore initialisé.

Je suppose que tu as voulu écrire :

Sub DEPLACEMENT1()
Dim derlign As Long, i&, LigneCible
With Sheets("VALIDATION BC")
   derlign = .Range("A" & .Rows.Count).End(xlUp).Row
   LigneCible = 4
   For i = 5 To derlign
      If .Range("O" & i) <> "" Then
            .Range("C" & i).Copy Sheets("EDITION BC").Range("A" & LigneCible)
            .Range("D" & i).Copy Sheets("EDITION BC").Range("B" & LigneCible)
            LigneCible = LigneCible + 1
      End If
   Next
End With
End Sub

Avec ce code, il ne se passe rien car Range("O" & i) = ""

Les lignes ou tu écriras quelque chose seront copiés sur la feuille cible.

Remarque qu'on n'Active ni ne Sselect aucune feuille et aucun Range

Tous les Range et Rows sont qualifiés avec With Sheets("VALIDATION BC") et un . (point) devant .Range er .Rows

et ceux de la feuille Cible par le nom de la feuille...

Il n'y a pas de "=" entre Source.Copy et destination

A+

Merci pour la réponse. En faite ce que je veux faire est plus complexe que cela.

Dans un premier temps je voudrais programmer la copie automatique de la saisie des différentes informations de la première feuille "validation BC" sur l'avant dernière feuille "synthèse en cours".

Dans un deuxième temps, je voudrais que quand je saisie la "Date du BC" sur la première feuille, celle-ci se désactive, et activer la deuxième feuille "Edition BC" pour continuer la saisie, sachant que mon rapport entre toutes les feuilles sera le n° de bon de commande. Donc programmer la copie automatique de la saisie de la deuxième feuille "Edition BC sur l'avant dernière feuille "synthèse en cours". Et supprimer la ligne de la première feuille "validation BC" car celle-ci est passé sur la deuxième feuilles.

J'espère être clair dans mes explications et que cela est possible.

Je vous remercie par avance de toute l'aide que vous pourrez me fournir.

Cordialement.

Pour le moment je bloque sur ce code :

[Code]Private Sub Worksheet_Change(ByVal Target As Range)

Dim DernLign As Long, i&, LignCible

derlign = .Range("A" & .Rows.Count).End(xlUp).Row

LigneCible = 4

For i = 5 To derlign

If .Range("O" & i) <> "" Then

Sheets("Edition BC").Activate

.Range("C" & i).Copy Sheets("EDITION BC").Range("A" & LignCible)

.Range("D" & i).Copy Sheets("EDITION BC").Range("B" & LignCible)

.Range("O" & i).Copy Sheets("EDITION BC").Range("C" & LignCible)

LigneCible = LigneCible + 1

End If

Next

End Sub[Code]

Bonsoir à tous,

J'ai un peu progressé dans ce que je voulais faire mais je n'obtiens pas encore l'effet désiré, voici le code :

[code]

Private Sub CommandButton1_Click()

Dim TableauValidationBC() As String

Dim l As Integer

Dim DernLign As Long, i&, LignCible

Dim Table1, Table2 As ListObjects

Set Table1 = ThisWorkbook.Worksheets("VALIDATION BC").ListObjects("TableauValidationBC")

With Table1

DernLign = Range("A" & Rows.Count).End(xlUp).Row

LignCible = 6

For i = 6 To DernLign

If Range("N" & i) = "OUI" Then

Range("C" & i).Copy Sheets("EDITION BC").Range("A" & LignCible)

Range("D" & i).Copy Sheets("EDITION BC").Range("B" & LignCible)

Range("A" & i).Copy Sheets("SYNTHESE EN COURS").Range("A" & LignCible)

Range("B" & i).Copy Sheets("SYNTHESE EN COURS").Range("B" & LignCible)

Range("C" & i).Copy Sheets("SYNTHESE EN COURS").Range("C" & LignCible)

Range("D" & i).Copy Sheets("SYNTHESE EN COURS").Range("D" & LignCible)

Range("E" & i).Copy Sheets("SYNTHESE EN COURS").Range("E" & LignCible)

Range("F" & i).Copy Sheets("SYNTHESE EN COURS").Range("F" & LignCible)

Range("G" & i).Copy Sheets("SYNTHESE EN COURS").Range("G" & LignCible)

Range("H" & i).Copy Sheets("SYNTHESE EN COURS").Range("H" & LignCible)

Range("I" & i).Copy Sheets("SYNTHESE EN COURS").Range("I" & LignCible)

Range("J" & i).Copy Sheets("SYNTHESE EN COURS").Range("J" & LignCible)

Range("K" & i).Copy Sheets("SYNTHESE EN COURS").Range("K" & LignCible)

Range("L" & i).Copy Sheets("SYNTHESE EN COURS").Range("L" & LignCible)

Range("M" & i).Copy Sheets("SYNTHESE EN COURS").Range("M" & LignCible)

LignCible = LignCible + 1

Range("A" & i).EntireRow.Delete

Sheets("Edition BC").Activate

End If

Next

End With

l = 39

ReDim TableauValidationBC(l)

End Sub

[Code]

J'espère vraiment arriver à corriger les petits problème que je rencontre, car actuellement il me copie tout les données sans exception dans la feuille "synthese en cours", et oublie certaine données en copiant dans la feuille "Edition BC".

Si vous avez des suggestion, je suis preneur.

Cordialement.

Je vous mets le fichier en question à dispo si besoin.

Bonjour,

Une solution :

Private Sub CommandButton1_Click()
Dim WsE As Worksheet, WsS As Worksheet
Dim DernLign&, i&, LignCible&
Set WsE = Sheets("EDITION BC")
Set WsS = Sheets("SYNTHESE EN COURS")
   DernLign = Range("A" & Rows.Count).End(xlUp).Row
   LignCible = 6
       For i = 6 To DernLign
           If Range("N" & i) = "OUI" Then
           Range("C" & i).Copy WsE.Range("A" & LignCible)
           Range("D" & i).Copy WsE.Range("B" & LignCible)
           Range("A" & i).Copy WsS.Range("A" & LignCible)
           Range("B" & i).Copy WsS.Range("B" & LignCible)
           Range("C" & i).Copy WsS.Range("C" & LignCible)
           Range("D" & i).Copy WsS.Range("D" & LignCible)
           Range("E" & i).Copy WsS.Range("E" & LignCible)
           Range("F" & i).Copy WsS.Range("F" & LignCible)
           Range("G" & i).Copy WsS.Range("G" & LignCible)
           Range("H" & i).Copy WsS.Range("H" & LignCible)
           Range("I" & i).Copy WsS.Range("I" & LignCible)
           Range("J" & i).Copy WsS.Range("J" & LignCible)
           Range("K" & i).Copy WsS.Range("K" & LignCible)
           Range("L" & i).Copy WsS.Range("L" & LignCible)
           Range("M" & i).Copy WsS.Range("M" & LignCible)
           LignCible = LignCible + 1
           WsE.Activate
           End If
       Next
End Sub

Cette solution est équivalente :

Private Sub CommandButton1_Click()
Dim WsE As Worksheet, WsS As Worksheet
Dim i&, iC&, DernLign&, LignCible&
Set WsE = Sheets("EDITION BC")
Set WsS = Sheets("SYNTHESE EN COURS")
   DernLign = Range("A" & Rows.Count).End(xlUp).Row
   LignCible = 6
       For i = 6 To DernLign
           If Range("N" & i) = "OUI" Then
            Range("C" & i).Copy WsE.Range("A" & LignCible)
            Range("D" & i).Copy WsE.Range("B" & LignCible)
             For iC = 1 To 13
                Cells(i, iC).Copy WsS.Cells(LignCible, iC)
             Next
            LignCible = LignCible + 1
            WsE.Activate
           End If
       Next
End Sub

A+

Bonsoir,

Merci pour la réponse. Si je peux me permettre quel est la signification de iC dans le code ?

De plus je voudrais supprimer les lignes que je copie dans le tableau, et quand je rajoute ce bout de code :

Range("A" & i).EntireRow.Delete

Cela me fait des erreurs, j'ai une ligne que ne se copie pas.

A bientot.

iC est une variable qui représente le N0 de colonne. le N° de colonne

ça ne fait pas d'erreur si tu ne Delete pas !

On ne Delete pas n'importe quand, n'importe comment :

Si tu Delete une ligne en descendant les lignes, les autres remontent

Par exemple dans une boucle de

For i = 6 à 20

Quand i = 6, Si tu supprimes la ligne

la ligne 7 devient alors la nouvelle ligne 6

Et quant le Next arrive i va passer à 7

Oui mais entre temps la ligne 7 est devenue la ligne 6 elle ne sera donc pas examinée.

C'est pourquoi en principe on ne Delete jamais une ligne en descendant une boucle For...Next mais en remontant de la dernière à la première.

Bon... Si personne ne passe par là avant, je verrais ça demain matin.

Merci pour ces explications en effet je comprends mieux !

Vraiment merci !

Bonsoir,

Je pense avoir progresser un peu mais je bloque sur la fonction de suppression de ligne. Voici le code :

[Code]

Private Sub CommandButton1_Click()

Dim WsE1 As Worksheet, WsSC3 As Worksheet

Dim DebLign As Long

Dim FinLign As Long

Dim Lign As Long

Dim NbSupLign As Long

Dim SupLign As Boolean

Dim i&, iC&, DernLign&, LignCible&

Set WsE1 = Sheets("EDITION BC")

Set WsSC3 = Sheets("SYNTHESE EN COURS")

DernLign = Range("A" & Rows.Count).End(xlUp).Row

LignCible = 6

'Je boucle sur les lignes

For Lign = FinLign To DebLign

'pour la ligne en cours je désactive la posibilité de la suppression

SupLign = False

For i = 6 To DernLign

'Si ma cellule contient le mot : OUI

If Range("N" & i) = "OUI" Then

'J'active la possibilité de suppression

SupLign = True

'Je copie mes valeurs dans le tableau suivant

Range("C" & i).Copy WsE1.Range("A" & LignCible)

Range("D" & i).Copy WsE1.Range("B" & LignCible)

'Je copie toutes les valeurs pour mon historique

Range("A" & i).Copy WsSC3.Range("A" & LignCible)

Range("B" & i).Copy WsSC3.Range("B" & LignCible)

Range("C" & i).Copy WsSC3.Range("C" & LignCible)

Range("D" & i).Copy WsSC3.Range("D" & LignCible)

Range("E" & i).Copy WsSC3.Range("E" & LignCible)

Range("F" & i).Copy WsSC3.Range("F" & LignCible)

Range("G" & i).Copy WsSC3.Range("G" & LignCible)

Range("H" & i).Copy WsSC3.Range("H" & LignCible)

Range("I" & i).Copy WsSC3.Range("I" & LignCible)

Range("J" & i).Copy WsSC3.Range("J" & LignCible)

Range("K" & i).Copy WsSC3.Range("K" & LignCible)

Range("L" & i).Copy WsSC3.Range("L" & LignCible)

Range("M" & i).Copy WsSC3.Range("M" & LignCible)

'Je change de ligne

LignCible = LignCible + 1

'J'active mon deuxième tableau

WsE1.Activate

End If

'Si précédemment j'ai activé la possibilité de suppression

If SupLign = True Then

'Je supprime ma ligne

Rows(Lign & ":" & Lign).Delete Shift:=xlUp

'Et je remonte sur la ligne supprimer car la ligne 7 si supprimer devient la ligne 6

Lign = Lign - 1

'Si le total des lignes examiner correspoond au nombre de ligne dans mon tableau j'arrete l'examen

If (Lign + NbSupLign) >= FinLign Then Exit For

End If

Next

'Je passe à la ligne suivante

Next Lign

End Sub

[Code]

J'ai souligné la ligne sur laquelle je suis bloqué. Si quelqu'un a une idéé...

Merci pour le coup de main.

Cordialement.

Bonjour,

Je t'avais oublié toi...

Bon, c'est pas fameux mais finalement j'ai conservé la suppression descendante.

Si tu en restes là dans ton bricolage, ça suffira bien.

Mais il faut être conscient que manipuler la variable de la boucle For, c'est pas fameux...

Private Sub CommandButton1_Click()
Dim WsE1 As Worksheet, WsSC3 As Worksheet
Dim i&, iC&, DernLign&, LignCible&
Set WsE1 = Sheets("EDITION BC")
Set WsSC3 = Sheets("SYNTHESE EN COURS")
DernLign = Range("A" & Rows.Count).End(xlUp).Row
LignCible = 6
   For i = 6 To DernLign
       If Range("N" & i) = "OUI" Then
       Range("A" & i).Copy WsSC3.Range("A" & LignCible)
       Range("B" & i).Copy WsSC3.Range("B" & LignCible)
       Range("C" & i).Copy WsSC3.Range("C" & LignCible)
       Range("D" & i).Copy WsSC3.Range("D" & LignCible)
       Range("E" & i).Copy WsSC3.Range("E" & LignCible)
       Range("F" & i).Copy WsSC3.Range("F" & LignCible)
       Range("G" & i).Copy WsSC3.Range("G" & LignCible)
       Range("H" & i).Copy WsSC3.Range("H" & LignCible)
       Range("I" & i).Copy WsSC3.Range("I" & LignCible)
       Range("J" & i).Copy WsSC3.Range("J" & LignCible)
       Range("K" & i).Copy WsSC3.Range("K" & LignCible)
       Range("L" & i).Copy WsSC3.Range("L" & LignCible)
       Range("M" & i).Copy WsSC3.Range("M" & LignCible)
       LignCible = LignCible + 1
       Rows(i).Delete Shift:=xlUp
       i = i - 1
       End If
   Next
End Sub

Idéalement il vaudrait mieux terminer la boucle for sans suppression puis refaire la boucle à l'envers

Private Sub Version2_Click()
Dim WsE1 As Worksheet, WsSC3 As Worksheet
Dim i&, iC&, DernLign&, LignCible&
Set WsE1 = Sheets("EDITION BC")
Set WsSC3 = Sheets("SYNTHESE EN COURS")
DernLign = Range("A" & Rows.Count).End(xlUp).Row
LignCible = 6
   For i = 6 To DernLign
       If Range("N" & i) = "OUI" Then
       Range("A" & i).Copy WsSC3.Range("A" & LignCible)
       Range("B" & i).Copy WsSC3.Range("B" & LignCible)
       Range("C" & i).Copy WsSC3.Range("C" & LignCible)
       Range("D" & i).Copy WsSC3.Range("D" & LignCible)
       Range("E" & i).Copy WsSC3.Range("E" & LignCible)
       Range("F" & i).Copy WsSC3.Range("F" & LignCible)
       Range("G" & i).Copy WsSC3.Range("G" & LignCible)
       Range("H" & i).Copy WsSC3.Range("H" & LignCible)
       Range("I" & i).Copy WsSC3.Range("I" & LignCible)
       Range("J" & i).Copy WsSC3.Range("J" & LignCible)
       Range("K" & i).Copy WsSC3.Range("K" & LignCible)
       Range("L" & i).Copy WsSC3.Range("L" & LignCible)
       Range("M" & i).Copy WsSC3.Range("M" & LignCible)
       LignCible = LignCible + 1
End If
   Next
   'On reprend la boucle à l'envers
   For i = DernLign To 6 Step -1
      If Range("N" & i) = "OUI" Then Rows(i).Delete Shift:=xlUp
   Next
End Sub

A+

Merci, ça va beaucoup m'aider ! J'essaierais cela demain ! Mais vraiment merci !

Bonjour,

Effectivement cela fonctionne, il me fait juste une petite erreur en plus dans la feuille "SYNTHESE EN COURS" dans laquelle il me rajoute des cellules dans la colonne DEVIS DEMAT en #VALEUR! à la fin du tableau.

Je vais continuer sur la programmation et vois si il y a une incidence ou pas.

Merci encore pour cette aide.

Je pense que je reviendrais pour compléter le code.

A bientôt.

Bonjour,

Cette erreur n'est pas due au code mais aux suppressions effectuées et à une mauvaise utilisation des tableaux Excel.

Normalement un tableau Excel ne devraient pas être surdimensionné. Il doit être dimensionné exactement au nombre de ligne de son contenu.

Il s'étend automatiquement (y compris les formules) tout seul quand tu rajoutes une donnée sur la ligne qui suit la dernière.

De même il s'étend automatiquement en largeur si tu ajoute une donnée dans la colonne qui suit la dernière.

A+

Rebonjour,

D'accord je comprend mieux. Il y vrai que les tableaux sont prévu pour contenir une année d'opération donc le tableau va être très grand. J'espère que cela va fonctionner dans le temps. Je verrais bien.

Sinon, encore une difficulté, mais la je pense que ça viens de ma définition d'égalité de cellule entre deux feuilles.

[Code]

Dim WsV2 As Worksheet, WsSC3 As Worksheet

Dim i&, iC&, DernLign&, LignCible&

Set WsV2 = Sheets("VALIDATION FACTURE")

Set WsSC3 = Sheets("SYNTHESE EN COURS")

DernLign = Range("A" & Rows.Count).End(xlUp).Row

LignCible = 6

For i = 6 To DernLign

If Range("H" & i) = "OUI" Then

Range("A" & i).Copy WsV2.Range("A" & LignCible)

Range("B" & i).Copy WsV2.Range("B" & LignCible)

End If

If Range("A" & i) = WsSC3.Range("A" & i) Then

Range("C" & i).Copy WsSC3.Range("N" & LignCible)

Range("D" & i).Copy WsSC3.Range("O" & LignCible)

Range("F" & i).Copy WsSC3.Range("P" & LignCible)

Range("G" & i).Copy WsSC3.Range("Q" & LignCible)

Range("H" & i).Copy WsSC3.Range("R" & LignCible)

WsV2.Activate

End If

Next

'Je reprends la boucle à l'envers

For i = DernLign To 6 Step -1

If Range("H" & i) = "OUI" Then Rows(i).Delete Shift:=xlUp

Next

[Code]

Je vais rechercher sur internet, je ne pense pas que cela soit compliquer.

A bientôt.

Cette manie d'activer et de sélecter n'importe quoi !

Ça marchait trop bien : Pourquoi diable avoir mis :

WsV2.Activate

A+

Bonjour,

Oui le code fonctionne bien, il n'y pas de probleme. La je suis sur la feuille "Edition BC" sur laquelle je complète la feuille et je voudrais ajouter les données saisies sur les lignes correspondantes dans la feuille synthèse en cours. C'est vrai que je n'ai pas préciser cela.

Cordialement.

Faites un effort d'explication !

Je ne comprend rien à votre réponse : Est-ce une question ?

Si vous avez une question supplémentaire, joignez le fichier actualisé au moment même de la question :

Comme vous semblez vouloir vous balader d'une feuille à l'autre, je ne peux pas me projeter dans votre process : Et je ne peux pas me fier à mon propre fichier car le mien est forcément bon... En plus vous y rajouter toujours des bricoles imprévues !

Sauf spécification particulière une macro agit sur la feuille en cours.

Quand vous écrivez :

If Range("H" & i) = "OUI" Then

...Range("H" & i) se rapporte à la feuille en cours. (WsE1 As Worksheet)

Quand vous écrivez :

Range("A" & i).Copy WsSC3.Range("A" & LignCible)

...Range("A" & i). se rapporte à la feuille en cours. (WsE1 As Worksheet)

et la copie se fait sur WsSC3

Si vous voulez changer de feuille source ou de feuille cible inutile d'activer quoique ce soit.

Puisque vous avez déclaré : WsV2 et

Set WsV2 = Sheets("VALIDATION FACTURE")

Ecrivez ensuite :

WsV2.Range("blabla")...

...ou mieux :

With WsV2
.Range("blabla") 'sans oublier le .  devant Range...
End With

Les Select et autre Activate ralentissent le code, le rendent peu lisible et provoquent un effet de flashage désagréable.

A+