Bonjour,
j'ai essayé de programmer une petite macro pour crée des étiquettes avec une manière très basique .
mon probléme c'est que je peux pas faire la macro tournner sur seulement les quatres premiére Colonne (A.D.C et D) ==> taille d'une feuille A4 .
pour les premiéres étiquettes c'est bonne , mais pour le reste il me mis des une en bas des autre seulement pour la derniére colonne (D)
merci de m'aider.
au bien si vous avez une autre astuce merci .
haytoch salut
j'ai essayé de programmer une petite macro pour crée des étiquettes avec une manière très basique .
mon probléme c'est que je peux pas faire la macro tournner sur seulement les quatres premiére Colonne (A.D.C et D) ==> taille d'une feuille A4 .
pour les premiéres étiquettes c'est bonne , mais pour le reste il me mis des une en bas des autre seulement pour la derniére colonne (D)
Code:
Sub Manuf_Teckets()
Dim Bws As Worksheet, Dws As Worksheet, C7ws As Worksheet, Mdl As Worksheet
Dim i As Long, C7_Line As Long, j As Integer, k As Integer
Set Mdl = Sheets("Model")
Set Bws = Sheets("BDD")
Set Dws = Sheets("Teckets")
Set C7ws = Sheets("Exemple")
With Dws
'Taille des etiquétes 4C/1999L
.Columns("A:D").Delete 'clean
.Columns("A:D").ColumnWidth = 22.57
.Rows("2:2000").RowHeight = 144 / 3
End With
With C7ws
k = 2
j = 1
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
Mdl.Range("A1:A3").Copy
Dws.Activate
Dws.Cells(k, j).Select
ActiveSheet.Paste
Key = .Cells(i, 1).Value
C7_Line = Application.WorksheetFunction.Match(Key, Bws.Range("A:A"), 0)
Bws.Range("B" & C7_Line).Copy
Dws.Activate
Dws.Cells(k, j).Select
ActiveSheet.Paste
Bws.Range("C" & C7_Line).Copy
Dws.Activate
Dws.Cells(k + 1, j).Select
ActiveSheet.Paste
Bws.Range("A" & C7_Line).Copy
Dws.Activate
Dws.Cells(k + 2, j).Select
ActiveSheet.Paste
'problématique
If i <= 4 Then
j = j + 1
k = k
Else
j = j
k = k + 3
End If
Next i
End With
End Sub
au bien si vous avez une autre astuce merci .
haytoch salut