etiketten in excel

[corania17]

Geachte specialisten. Ik ben aan het zoeken geweest naar een macro waarmee het mogelijk is om stickers rechtstreeks vanuit Excel te printen. In mijn zoektocht heb ik wel wat gevonden en ook aangepast echter was deze macro gemaakt voor 2 etiketten per regel, terwijl ik 3 etiketten op een regel wil hebben. Is er iemand die mij daarbij zou kunnen helpen? Ik stuur hierbij de file met de macro voor 2 etiketten. Ik heb al van alles geprobeerd maar kom er niet uit om deze te veranderen naar 3 etiketten. Ik hoop dat er iemand is die mij van dienst zou kunnen en willen zijn. Met vriendelijke groet, Rubik.Bekijk bijlage helpmij etiket.xls

 

[HSV]

Sub CKP()
Links = True
t1 = 2
With Sheets("invoer")
    ar = .Range("A5:F" & .Cells(.Rows.Count, 3).End(xlUp).Row + 1)
End With
With Sheets("Etikettenprinten")
    .Cells.ClearContents
    For j = 1 To UBound(ar) - 1
        If ar(j, 3) = ar(j + 1, 3) Then
        t = t + 1
        Else
            If Links Then t2 = 0 Else[COLOR=#0000ff] t2 = t2 + 4[/COLOR]
            With .Cells(1)
                .Offset(t + t1 - 1, t2 + 1).Resize(, 2) = Array(ar(j, 2), ar(j, 1))
                .Offset(t + t1, t2 + 1).Resize(, 2) = Array(ar(j, 3), ar(j, 1))
                .Offset(t + t1 + 1, t2 + 1).Resize(, 2) = Array(ar(j, 4), ar(j, 1))
                .Offset(t + t1 + 2, t2 + 1).Resize(, 2) = Array(ar(j, 5), ar(j, 1))
                .Offset(t + t1 + 3, t2 + 1).Resize(, 2) = Array(ar(j, 6), ar(j, 1))
                .Offset(t1 - 2, t2) = Sheets("invoer").[A3] & " " & Sheets("invoer").[A1]
                .Offset(t1 - 1, t2) = Sheets("invoer").[A4] 'Familie
                .Offset(t1 + 4, t2) = Sheets("invoer").[A2] 'datum
                .Offset(t1 + 4, t2 + 2) = Sheets("invoer").[B1] 'CD
            End With


[COLOR=#0000ff]            If j Mod 3 = 0 Then[/COLOR]
[COLOR=#0000ff]               Links = Not Links[/COLOR]
[COLOR=#0000ff]                t1 = t1 + 7[/COLOR]
[COLOR=#0000ff]            Else[/COLOR]
[COLOR=#0000ff]               Links = False[/COLOR]
[COLOR=#0000ff]            End If[/COLOR]
          t = 0
         End If
    Next j
End With
End Sub

 

[corania17]

Heel hartelijk bedankt voor de reactie, werkt perfect. Zal de melding op afgehandeld zetten. Met vriendelijke groet, Corania.