boucle copie cellule A1 puis A2 etc.

**adrien1987** · 04/10/2021, 17h55

Bonjour

Je suis à la recherche d'un code VBA avec déroulement comme ci-dessous
- copie la cellule A1
- next
-Copie la cellule A2
-next
-etc...
-détection cellule vide = arrêt de la boucle

j'ai déjà une macro en cours de construction dans le module 1 "sub copie"

Merci pour votre aide

Bonne soirée
fkt print auto.xlsm

**halaster08** · 05/10/2021, 10h44

Bonjour,

Plutôt que le fichier joint, donne directement ton code dans le message (avec la balise code) tu auras plus de réponses

- copie la cellule A1
- next

Copier c'est bien mais tu comptes en faire quoi de ta copie ?

**adrien1987** · 05/10/2021, 14h42

Envoyé par halaster08

Bonjour,

Plutôt que le fichier joint, donne directement ton code dans le message (avec la balise code) tu auras plus de réponses

Copier c'est bien mais tu comptes en faire quoi de ta copie ?

Bonjour halaster

Oui tu as raison dsl ! voici le code

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Sub copie()
'
'macro remise en forme les cellules 
 
Application.Run "'fkt print auto.xlsm'!miseenforme"
 
'commencement de la boucle
 Dim i As Integer
 
 
 For ligne = 1 To 5 'Instructions
 
 
 'af
    Sheets("data").Select
   Range("A1").Select
 
    Selection.Copy
 
    Sheets("fkt").Select
    Range("nvol").Select
    ActiveSheet.Paste
 
 
    'heure
    Sheets("data").Select
    Range("D1").Select
    Selection.Copy
 
    Sheets("fkt").Select
    Range("heure").Select
    ActiveSheet.Paste
 
 
    'poids
    Sheets("data").Select
    Range("x1").Select
    Selection.Copy
 
    Sheets("fkt").Select
    Range("poids").Select
    ActiveSheet.Paste
 
 
    Sheets("FKT").Select
    Range("heure").Select
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("FKT").Select
    Range("poids").Select
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("FKT").Select
    Range("nvol").Select
With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
 'fin de la boucle
 
Next
 
 
Exit Sub
 
End Sub

Chaque copier --> colle dans une cellule sur l'onglet "FKT", à la fin de chaque boucle cela déclenchera une impression de la fiche FKT avec les informations prises sur le 1er onglet "data".

barpasc · 11/10/2021, 09h37

Les modifs rapides sur le script (du genre on dénude le fil, on fait des noeuds et on met du ruban adhésif...). Pourquoi? Parce que ce script fonctionnera pour une centaine de lignes, un millier au mieux selon la puissance de la machine, à cause des select. Si c'est juste ça, autant faire simple.

Le reste du message ne s'est pas affiché. C'était reprendre le script existant et modifier les selects

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
'Range("A1").Select en
Range("A" & ligne).Select
 
'Range("D1").Select en
Range("D" & ligne).Select
 
'Range("x1").Select
Range("x" & ligne).Select

Pour les champs nommés (bonne idée d'utilisation), le script n'a pas besoin d'être modifié

Envoyé par adrien1987

...

**Pierre Fauconnier** · 11/10/2021, 10h50

Salut.

Il faudrait que tu donnes une copie d'écran de ta feuille data et de ta feuille FTK, pour que l'on puisse se rendre compte de la manip (le top, ce serait avec déjà quelques données transférées).

Les Select sont à bannir pour ce genre de traitement. Si on doit vraiment réaliser cela cellule par cellule, une bonne façon de faire est d'utiliser quelque chose du genre: Target.Value = Source.Value.

En voyant comment est organisé ton classeur, nous pourrons probablement t'aiguiller vers la solution optimale.

**Alex020181** · 13/10/2021, 00h44

Bonjour,

Si je me base sur le fichier que tu as joins à ton premier message tu as 2 feuilles.
- Une feuille "data" contenant simplement des données en lignes et colonnes
- Une feuille "fkt" contenant une image de fond répétée x fois en longueur et hauteur
- Ton but est de compléter "fkt" avec les données de "data" en superposant les données à l'image de fond. Ces données sont à positionner dans des cellules précises afin de faire matcher le texte et l'image de fond

C'est simple et tu n'as même pas besoin de VBA. Il te suffit de créer des formules interfeuilles.
Une formule interfeuille se compose ainsi

=nom_feuille_origine!cellule_origine

à insérer dans ta cellule de destination.

Pour ton cas précis il te suffit de saisir la formule suivante dans la cellule B30 de ta feuille "fkt"
=data!A1

Nom : FKT.png
Affichages : 364
Taille : 698,6 Ko

Nom : FKT.png
Affichages : 364
Taille : 698,6 Ko

Quand je dis saisir je ne m'attends pas à ce que tu tapes réellement la formule à la main bien sûr hein. On se comprend.
Tu tapes le = puis tu vas cliquer sur la cellule source.

Même principe pour les autres cellules.

Il est vrai que la mise en place de ces formules sera longue la première fois mais ensuite tu n'auras plus qu'à modifier les valeurs de "data" pour que "fkt" se mette à jour automatiquement.

Je te conseille de prévoir assez de FKT pour pallier à un nombre plus ou moins grand de lignes dans "data". Pas grave si tu prépares des FKT avec des formules pointant sur des cellules vides dans "data". Au moins tu en auras en plus pour la prochaine fois.

Pour le coup pas besoin de nommer tes cellules mais attention de bien les fusionner correctement. Tous tes FTK ne sont pas ajustés correctement aux cellules.

Je t'ai fais les 2 premiers (vol, heure, masse) pour amorcer la pompe.

Si vraiment tu veux du VBA c'est possible mais pas forcément utile dans ton cas.

**adrien1987** · 13/10/2021, 11h28

bonjour

Merci à vous pour votre aide, j'ai réussi à mettre en forme un code vba qui me convient avec vos différentes suggestions proposées.

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Dim i As Integer
 
 
 For ligne = 1 To 18 'Instructions
 
    'af
    Sheets("data").Select
   Range("A" & ligne).Select
    Selection.Copy
     Sheets("fkt").Select
    Range("nvol").Select
    ActiveSheet.Paste
     Selection.Font.Size = 26
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"
 
    'heure
    Sheets("data").Select
    Range("D" & ligne).Select
    Selection.Copy
    Sheets("fkt").Select
    Range("heure").Select
    ActiveSheet.Paste
    Selection.Font.Size = 26
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"
 
    'poids
    Sheets("data").Select
    Range("X" & ligne).Select
    Selection.Copy
    Sheets("fkt").Select
    Range("poids").Select
    ActiveSheet.Paste
    Selection.Font.Size = 20
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"
 
    'compo
    Sheets("data").Select
    Range("AD" & ligne).Select
    Selection.Copy
    Sheets("fkt").Select
    Range("compo2").Select
    ActiveSheet.Paste
    Selection.Font.Size = 18
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"
 
 'date
    Sheets("fkt").Select
    Range("date2").Select
 
    Selection.Font.Size = 25
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"
 
'akn
    Sheets("data").Select
    Range("T" & ligne).Select
    Selection.Copy
    Sheets("fkt").Select
    Range("akee").Select
    ActiveSheet.Paste
    Selection.Font.Size = 20
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"
 
    'blk
    Sheets("data").Select
    Range("u" & ligne).Select
    Selection.Copy
    Sheets("fkt").Select
    Range("blk").Select
    ActiveSheet.Paste
    Selection.Font.Size = 26
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"
 
'AKE/akh
    Sheets("data").Select
    Range("V" & ligne).Select
    Selection.Copy
    Sheets("fkt").Select
    Range("akeee").Select
 
 
    ActiveSheet.Paste
    Selection.Font.Size = 22
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"
 
Application.Run "'fkt print auto.xlsm'!imprimer"
Next
 
 
Exit Sub
 
End Sub

2éme étape:
Il me manque maintenant un moyen pour arrêter la boucle lorsqu'elle détecte dans la colonne A une cellule vide
Je sais seulement qu'il faudra déjà supprimer For ligne = 1 To 18 'Instructions
Avez-vous une idée svp ?

3éme étape
J'aimerai que si la cellule Akn "data" est vide passe à la seconde étape de la boucle

EX:

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
 
 
 'akn
    Sheets("data").Select
    Range("T" & ligne).Select
    Selection.Copy
    Sheets("fkt").Select
    Range("akee").Select
    ActiveSheet.Paste
    Selection.Font.Size = 20
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"
 
  ' Si cellule vide ne rien marquer = cellule suivante  
 
    'blk
    Sheets("data").Select
    Range("u" & ligne).Select
    Selection.Copy
    Sheets("fkt").Select
    Range("blk").Select
    ActiveSheet.Paste
    Selection.Font.Size = 26
    Application.Run "'fkt print auto.xlsm'!mise_forme_cellule_fkt"

fkt print auto.xlsm

**Alex020181** · 14/10/2021, 01h44

Bon. A priori tu restes sur le VBA.
Tu as au moins 2 façons de détecter si une cellule contient une valeur:
- vérifier le nombre de caractères de son contenu --> len()
- comparer son contenu avec "" --> "" représente une chaîne vide

Ensuite de ce que je voie dans tes messages précédents tu connais déjà le principe des boucles (du moins celle de for).

Pour finir tu dois utiliser, puisque tu as commencé avec for mais do loop ou while aurait été plus judicieux car avec for tu dois déclarer un numéro de ligne de fin, if qui te permet d'établir une condition:
syntaxe:

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
If ta_condition then
ton traitement si condition est vrai
Else
ton traitement si condition est fausse
End if

Tu peux aussi nettement améliorer ton code en terme de lisibilité et temps d'exécution

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sheets("data").Select
   Range("A" & ligne).Select
    Selection.Copy
     Sheets("fkt").Select
    Range("nvol").Select
    ActiveSheet.Paste
     Selection.Font.Size = 26

avec simplement

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sheets("fkt").Range("B" & ligne_ecrire) = Sheets("data").Range("A" & ligne_lue)
Sheets("fkt").Range("B" & ligne_ecrire).Font.Size = 26

Et donc:

Code vba :

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
 
For ligne_lue = 1 to 1048576 'puisque tu ne connais pas la fin je force à 1048576, il faudra sortir avec exit for
 
    If Sheets("data").Range("A" & ligne_lue) <> "" Then ' ou If len(Sheets("data").Range("A" & ligne_lue)) > 0 then
 
        ligne_ecrire = 30
 
        Sheets("fkt").Range("B" & ligne_ecrire) = Sheets("data").Range("A" & ligne_lue) ' num vol
        Sheets("fkt").Range("B" & ligne_lue).Font.Size = 26
 
        Sheets("fkt").Range("G" & ligne_ecrire) = Sheets("data").Range("D" & ligne_lue) ' heure
        Sheets("fkt").Range("G" & ligne_lue).Font.Size = 26
 
        Sheets("fkt").Range("C" & ligne_ecrire + 6) = Sheets("data").Range("X" & ligne_lue) ' masse
        Sheets("fkt").Range("C" & ligne_lue).Font.Size = 26
 
        ... je te laisse faire les autres
 
        ligne_ecrire = ligne_ecrire + 38 'pour commencer la deuxième ligne d'étiquettes
 
    Else
 
        Exit For
 
    End If
 
Next ligne_lue

Je t'ai donné le début. A toi de faire le reste mais d'abord commence par bien préparer ton quadrillage de cellules par rapport aux étiquettes.

**adrien1987** · 15/10/2021, 12h32

Bonjour Alex

Voici le code optimisé ! merci pour l'astuce c'est vrai il va beaucoup plus vite en traitement

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Sub copie() 'fiche fkt
 
Application.ScreenUpdating = False
 'Application.Run "'PPV 2.xlsm'!fkt.miseenforme"
 
 Dim i As Integer
 
 
For ligne_lue = 1 To 100 'puisque tu ne connais pas la fin je force à 1048576, il faudra sortir avec exit sub
 
 If Sheets("data").Range("A" & ligne_lue) <> "" Then
 nombredeboucle = nombredeboucle + ligne_lue
 
    'af
 Sheets("fkt").Range("nvol1" & ligne_ecrire) = Sheets("data").Range("A" & ligne_lue)
 Sheets("fkt").Range("nvol1").Font.Size = 36
 Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
 
'heure
Sheets("fkt").Range("heure" & ligne_ecrire) = Sheets("data").Range("D" & ligne_lue)
Sheets("fkt").Range("heure").Font.Size = 28
'Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
'Application.Run "'PPV 2.xlsm'!fkt.bordure_heure"
 
'poids
Sheets("fkt").Range("poids" & ligne_ecrire) = Sheets("data").Range("X" & ligne_lue)
Sheets("fkt").Range("poids").Font.Size = 26
'Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
 
'compo
Sheets("fkt").Range("compo" & ligne_ecrire) = Sheets("data").Range("AD" & ligne_lue)
Sheets("fkt").Range("compo").Font.Size = 20
'Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
 
 
'akn
If Sheets("data").Range("T" & ligne_lue) <> "" Then
Sheets("fkt").Range("akee" & ligne_ecrire) = Sheets("data").Range("T" & ligne_lue)
Sheets("fkt").Range("akee").Font.Size = 28
'Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
Else
 
'blk
If Sheets("data").Range("u" & ligne_lue) <> "" Then
Sheets("fkt").Range("akee" & ligne_ecrire) = Sheets("data").Range("u" & ligne_lue)
Sheets("fkt").Range("akee").Font.Size = 28
Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
Else
 
'AKE/akh
If Sheets("data").Range("v" & ligne_lue) <> "" Then
Sheets("fkt").Range("akee" & ligne_ecrire) = Sheets("data").Range("V" & ligne_lue)
Sheets("fkt").Range("akee").Font.Size = 28
Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
Else
 
 
 
'Application.Run "'PPV 2.xlsm'!fkt.imprimer"
 
 
End If
End If
End If
Else
Exit For
End If
 
Next ligne_lue
 
'msgbox compteur nombre de boucle
Msgbox "Vous avez  " & nombredeboucle & " étiquettes en-cours d'impression " & vbLf & "                        Imprimante ICDG1893"
 
Application.ScreenUpdating = True
End Sub

Je viens de tester pour mettre un msgbox à la fin de l'exécution de la boucle "ligne 12 et 72" qui indique combien de fois la boucle a tourné.

Résultat:
Oups mauvais calcul le msgbox me sort 351 étiquettes , j'ai dû me tromper quelque part

Je ne sais pas à quoi correspond ce chiffre surtout que mon For ligne_lue s'arrête à 100 !

**adrien1987** · 15/10/2021, 13h18

J'ai trouvé la solution :

-J'ai mis une cellule NBVAL (fkt!n3) > celle-ci me retourne le nombre de ligne non vide de la feuille (data!A:A)
-En début de la macro j'ai rajouté Sheets("FKT").Select.
-En fin j'ai rajouté dans le msgbox le n° de la cellule Range("N3") ce qui me donne le résultat
-voici la formule : Msgbox "Vous avez " & Range("N3") & " étiquettes en-cours d'impression " & vbLf & " Imprimante ICDG1893".

Nickel ça marche

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Sub copie() 'fiche fkt
 
Application.ScreenUpdating = False
 Sheets("FKT").Select
 'Application.Run "'PPV 2.xlsm'!fkt.miseenforme"
 
 Dim i As Integer
 
 
For ligne_lue = 1 To 100 'puisque tu ne connais pas la fin je force à 1048576, il faudra sortir avec exit sub
 
 If Sheets("data").Range("A" & ligne_lue) <> "" Then
 nombredeboucle = nombredeboucle + ligne_lue
 
    'af
 Sheets("fkt").Range("nvol1" & ligne_ecrire) = Sheets("data").Range("A" & ligne_lue)
 Sheets("fkt").Range("nvol1").Font.Size = 36
 Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
 
'heure
Sheets("fkt").Range("heure" & ligne_ecrire) = Sheets("data").Range("D" & ligne_lue)
Sheets("fkt").Range("heure").Font.Size = 28
'Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
'Application.Run "'PPV 2.xlsm'!fkt.bordure_heure"
 
'poids
Sheets("fkt").Range("poids" & ligne_ecrire) = Sheets("data").Range("X" & ligne_lue)
Sheets("fkt").Range("poids").Font.Size = 26
'Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
 
'compo
Sheets("fkt").Range("compo" & ligne_ecrire) = Sheets("data").Range("AD" & ligne_lue)
Sheets("fkt").Range("compo").Font.Size = 20
'Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
 
 
'akn
If Sheets("data").Range("T" & ligne_lue) <> "" Then
Sheets("fkt").Range("akee" & ligne_ecrire) = Sheets("data").Range("T" & ligne_lue)
Sheets("fkt").Range("akee").Font.Size = 28
'Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
Else
 
'blk
If Sheets("data").Range("u" & ligne_lue) <> "" Then
Sheets("fkt").Range("akee" & ligne_ecrire) = Sheets("data").Range("u" & ligne_lue)
Sheets("fkt").Range("akee").Font.Size = 28
Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
Else
 
'AKE/akh
If Sheets("data").Range("v" & ligne_lue) <> "" Then
Sheets("fkt").Range("akee" & ligne_ecrire) = Sheets("data").Range("V" & ligne_lue)
Sheets("fkt").Range("akee").Font.Size = 28
Application.Run "'PPV 2.xlsm'!fkt.mise_forme_cellule_fkt"
Else
 
 
 
'Application.Run "'PPV 2.xlsm'!fkt.imprimer"
 
 
End If
End If
End If
Else
Exit For
End If
 
Next ligne_lue
 
'msgbox compteur nombre de boucle
Msgbox "Vous avez  " & Range("N3") & " étiquettes en-cours d'impressions " & vbLf & "                        Imprimante ICDG1893"
Application.ScreenUpdating = True
End Sub

boucle copie cellule A1 puis A2 etc.

Macros et VBA Excel

Discussions similaires

Partager

Partager