VBA List to be put in sticker format - vba

Question

I have a list of data which needs to be printed out on stickers (imagine the Avery kind). I'm having trouble coming up with the code that will produce the desired result:
My code thus far is:
With wsEtiketten
' erase old data
.Cells.Clear
' enter new data
With .Cells(1, 2)
.Value = "Lettrine"
.Font.Bold = True
End With
.Cells(2, 2).Value = sAuswertungsLettrine
For i = 0 To MaxRow - 1
For j = 0 To 4
r.Copy .Cells(4, 2).Offset(i * 5, j * 5)
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 1).Value 'Page
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 2).Value 'Ordernr
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 2) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 8).Value 'Surf
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 9).Value 'Indice DB
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 3).Value 'Count
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 4).Value 'CA Brut
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 7).Value 'Marge
Next j
Next i
End With
The information which is tied to it is simply repeated across the row. I need i to change every time the field is offset. How can I do that? I'm sure this is probably programming kindergarden stuff but I'm not getting it.
Thanks!

Answer 1

Maybe an answer with an unexpected twist. You can use an Excel table in combination with Word to get the result you want as well. This is standard Office functionality:
http://support.microsoft.com/kb/318117/en
or in German:
http://support.microsoft.com/kb/318117/de

Answer 2

Ok. I managed to come up with an answer within Excel. Once I had it, it was obvious.
Here goes:
With wsEtiketten
' Alte Daten werden gelöscht
.Cells.Clear
' Neue Daten werden eingelesen
With .Cells(1, 2)
.Value = "Lettrine"
.Font.Bold = True
End With
.Cells(2, 2).Value = sAuswertungsLettrine
For i = 0 To MaxRow - 1
r.Copy .Cells(4, 2).Offset(WorksheetFunction.RoundDown(i / 5, 0) * 5, ((i + 5) Mod 5) * 5)
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 1).Value 'Page
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 2).Value 'Bestellnummer
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 2) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 8).Value 'Surf
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 9).Value 'Indice DB
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 3).Value 'Anzahl
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 4).Value 'CA Brut
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 7).Value 'Marge
Next i
End With