Discussion :

[jbgood]

Je souhaiterai créer une macro qui copie les cellules d'une ligne d'un tableau (si une cellule de cette ligne est égale à 1) et les coller vers des cellules d'une autre feuille sachant que la destination de copie est variable suivant d'autres cellules de cette seconde feuille.

Une fois copier mise à jour des calcules de la feuille puis exécuter une macro "imprimer".
Ensuite tester la cellule suivante du tableau de la 1ère feuille si égale 1 "rebelotte" on copie les cellules de la ligne dans la seconde feuille mise à jour de la feuille et appel macro "impression".
Si la cellule testé est égale a 0 on va tester la cellule suivante, la macro s'arrête lorsque la cellule testé est évide. Les cellules à tester sont dans la colonne "L".

Aujourd'hui je rempli tous les champs de la seconde feuille manuellement,
suivant les informations rempli cela renseigne les champs de cette feuille de calcul qu'ensuite j'imprime.

Mon but serai d'automatiser cette tache car toutes les données rempli manuellement sont disponible dans la 1er feuille de calcul.

J'ai plusieurs petit bout de macro pour actualisé mes feuilles, les imprimer, montrer cacher des lignes suivant les infos rempli manuellement et calculé etc
Mais concernant, le faites de tester si =1 ou =0 ou="", copier ces fameuses cellule, les coller au bonne endroit et faire une boucle je suis perdu et ne sais pas par où commencer

Je suis conscience que cela face fait peut-être beaucoup... Mais si vous auriez des bouts de code pour que je puisse essayer de faire quelque chose ce serai top.

J'ai préparer un fichier exemple pour mieux me faire comprendre
Ce sera certainement plus parlant que mon roman ....
J'espère que j'ai été assez clair... Merci d'avance pour votre aide.

[EricDgn]

Une possibilité, à insérer dans un module:

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
Sub LancerTraitement()
   Dim wSh1 As Worksheet, wSh2 As Worksheet
   Dim kR As Long, k As Long
   Set wSh1 = ActiveWorkbook.Sheets("REF")
   Set wSh2 = ActiveWorkbook.Sheets("FICHE")
   kR = 3      '--- première ligne à traiter
   While wSh1.Cells(kR, 1) <> ""          '--- continuer tant que cellule en colonne 1 non vide
      If wSh1.Cells(kR, 12) = 1 Then      '--- 12 = 12e colonne: L
         '--- copier de wSh1 sur wSh2
         wSh2.[E2] = wSh1.Cells(kR, 1)
         wSh2.[M2] = wSh1.Cells(kR, 2)
         wSh2.[H3] = wSh1.Cells(kR, 6)
         wSh2.[F6] = wSh1.Cells(kR, 3)
         wSh2.[J6] = wSh1.Cells(kR, 4)
         For k = 1 To 5
            wSh2.Cells(8, 2 + 2 * k) = wSh1.Cells(kR, 5 + k)
         Next k
         wSh2.PrintPreview          '--- aperçu avant impression
         'wSh2.PrintOut              '--- impression directe
      End If
      kR = kR + 1             '--- passer à la ligne suivante
   Wend
   Set wSh1 = Nothing
   Set wSh2 = Nothing
End Sub

Cordialement.

[jbgood]

Bonsoir,
Merci pour cette réponse, désolé j'ai supprimé le message car je pensais que se serai trop complexe.
Je vais étudier et tester votre code. Je vous tiendrai au courant.
Merci encore et bonne soirée enfin nuit !

J'ai testé rapidement votre code cela fonction plutôt bien, cependant les cellules ne se colle pas sur la bonne ligne dans la feuille fiche. Les cellules info doivent être coller dans la ligne 9 10 ou 11 en fonction de la valeur 1 ou 0 de la cellule A9 à A11. (J'ai regardé rapidement).
Mais franchement c'est déjà un gros avancement.
Je prendrai le temps de regarder en détail pas avant la fin de semaine....
Je vous tiens au courant dès que je peux.
Mille Merci pour votre aide.

[EricDgn]

Dans ce cas, ceci devrait convenir.

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
Sub LancerTraitement()
   Dim wSh1 As Worksheet, wSh2 As Worksheet
   Dim kR1 As Long, kR2 As Long, k As Long
   Set wSh1 = ActiveWorkbook.Sheets("REF")
   Set wSh2 = ActiveWorkbook.Sheets("FICHE")
   kR1 = 3      '--- première ligne à traiter
   While wSh1.Cells(kR1, 1) <> ""          '--- continuer tant que cellule en colonne 1 non vide
      If wSh1.Cells(kR1, 12) = 1 Then      '--- 12 = 12e colonne: L
         '--- copier de wSh1 sur wSh2
         wSh2.[E2] = wSh1.Cells(kR1, 1)
         wSh2.[M2] = wSh1.Cells(kR1, 2)
         wSh2.[H3] = wSh1.Cells(kR1, 6)
         wSh2.[F6] = wSh1.Cells(kR1, 3)
         wSh2.[J6] = wSh1.Cells(kR1, 4)
         wSh2.Range("D9:M12").ClearContents      '--- vider la plage
         Select Case wSh1.Cells(kR1, 3) & wSh1.Cells(kR1, 4)
            Case "CARREROUGE"
               kR2 = 9
            Case "CARREBLEU"
               kR2 = 10
            Case "CERCLEBLEU"
               kR2 = 11
            Case Else            '--- autre cas
               kR2 = 12
         End Select
         For k = 1 To 5
            wSh2.Cells(kR2, 2 + 2 * k) = wSh1.Cells(kR1, 5 + k)
         Next k
         wSh2.PrintPreview          '--- aperçu avant impression
         'wSh2.PrintOut              '--- impression directe
      End If
      kR1 = kR1 + 1             '--- passer à la ligne suivante
   Wend
   Set wSh1 = Nothing
   Set wSh2 = Nothing
End Sub

Bonne continuation.

[jbgood]

Bonsoir EricDgn,
Cela fonction très bien, Je vais adapter cela sur mon fichier.
Il y a plein d'autre macro dans mon fichier je vais compiler tous ça et j'espère ne pas avoir trop de surprise.
Vous avez fait un excellent travail, et je trouve que le code n'est pas trop difficile à comprendre grâce a vos explication.Un grand merci et un grand résolue pour vous .
Merci également à développez.net.

Bonne continuation et à bientôt!