Faire des étiquettes

Hum! Essaye celle-ci
Sub Ecriture()
Dim plg As Range, PlgB As Range, C As Object, A$, i#, j!, OptCalc,
Varinter$(499, 3)
Application.ScreenUpdating = False
OptCalc = Application.Calculation
Application.Calculation = xlCalculationManual
Sheets("Etiquettes").Activate
Sheets("Etiquettes").Cells.Select
With Selection
.ShrinkToFit = True
.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter
.ColumnWidth = 33.14
.RowHeight = 70.5
End With
Range("A:D").Select
ActiveSheet.PageSetup.PrintArea = "$A:$D"
With Selection.Font
.FontStyle = "Gras"
.Size = 12
End With
Set plg = Feuil2.Range("A1:D500")
Set PlgB = Sheets("Base").Range("A2:F2000")


For Each C In Sheets("Base").Range("A2:A2000")

A = C.Value & " " & C.Offset(0, 1).Value & Chr(10) & C.Offset(0, 4).Value &
" " & C.Offset(0, 5).Value
If C.Value = "" Then
plg.Value = Varinter()
Set plg = Nothing
Set PlgB = Nothing
Set C = Nothing
Exit Sub
End If
Varinter(i, j) = A
If j = 3 Then
i = i + 1
End If
j = j + 1 + (j = 3) * 4

Next

Set plg = Nothing
Set PlgB = Nothing
Set C = Nothing
Application.Calculation = OptCalc
End Sub
"crole" <contactbruno@skynet.be> a écrit dans le message de news:
1146817998.386349.316490@g10g2000cwb.googlegroups.com...
Bonjour Fredo,

Merci à toi de te pencher sur mon problème

j'ai essayé mais il bogue sur la ligne

Columns("A:D").Select
Et je ne sais pas pourquoi
Merci
Salutation
Crole