Inserting entries on new sheet based on a data sheet - excel

Question

From our drawing program we receive a sheet with data for sawing sheet material. We want to make a sticker for each unique plate.
The idea is, rearrange the data into a sticker format on a new sheet.
jpeg image for example.
Sub Platen_stickers()
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim xLast As Long
Dim rw As Range
Dim aantalrng As Range
Dim aantal As Range
Dim plaattype As Range
Dim Merk As String, Label As String, Lengte As String, Breedte As String
Dim stickeraantal As Byte, stickergemaakt As Byte
Dim sticker As Range
Dim row As Range
Dim x As Long
On Error Resume Next
xLast = ActiveWorkbook.Sheets(1).Cells(Rows.Count, "B").End(xlUp).row 'searching last filled cell in column B
For i = 8 To xLast Step 1
If Sheets(1).Cells(i, "B").Value2 = "Code" Then 'searching for header "Code" in column B
Set plaattype = Sheets(1).Cells(i + 1, "B") 'defining the cell below "Code" as range "plaattype"
Set aantal = plaattype.Offset(0, 2) 'defining cell in row below "Code" and in column D as range "aantal"
Set aantalrng = Range(aantal, aantal.End(xlDown)) 'defining all numbers in column D under this header as range "aantalrng"
'inserting new sheet for stickers after current last sheet
ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.Name = plaattype.Value2 'editing sheet name to current type
Set sticker = ActiveSheet.Range(1, 1) 'defining cell A1 of current sheet as current sticker
With ActiveSheet.Range("A1:F31") 'adjusting cell dimensions of range A1:F32 to sticker format (96 sticker per sheet)
.Columns("A:F").ColumnWidth = 18.14
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
For Each rw In ActiveSheet.Range("A1:F32").Rows
If rw.row Mod 2 = 0 Then
rw.RowHeight = 5.25
Else: rw.RowHeight = 53.25
End If
Next rw
With ActiveSheet.PageSetup 'adjusting print settings to fit stickersheet
.CenterHorizontally = True
.CenterVertically = True
.LeftMargin = Application.CentimetersToPoints(0)
.RightMargin = Application.CentimetersToPoints(0)
.TopMargin = Application.CentimetersToPoints(0.6)
.BottomMargin = Application.CentimetersToPoints(0.6)
.HeaderMargin = Application.CentimetersToPoints(1.3)
.FooterMargin = Application.CentimetersToPoints(1.3)
.Zoom = 87
End With
x = 1 'setting sticker count on 1
'creating the actual sticker
For Each row In aantalrng 'running through current data for creating stickers
stickergemaakt = 0 'resetting counter made sticker in this row
stickeraantal = aantalrng.Cells(row, 1).Value 'checking how many stickers this row needs making (=value of column D)
Do Until stickergemaakt > stickeraantal 'looping until made stickers is needed stickers
Merk = aantalrng.Cells(row, 1).Offset(0, -1).Value 'collecting sticker input
Label = aantalrng.Cells(row, 1).Offset(0, -3).Value
Lengte = aantalrng.Cells(row, 1).Offset(0, 1).Value
Breedte = aantalrng.Cells(row, 1).Offset(0, 2).Value
sticker.Value = Merk & " " & Label & vbCrLf & Lengte & " x " & Breedte & " mm" & vbCrLf & plaattype 'writing sticker input in format on current cell on sticker sheet
If x < 6 Then
Set sticker = sticker.Offset(0, 1) 'adjusting to new empty sticker cell => next column
x = x + 1
ElseIf x = 6 Then
sticker = sticker.Offset(1, -6) 'until reached 6 columns, then next row to start again
x = 1
End If
stickergemaakt = stickergemaakt + 1 'adding counter made sticker with 1
Loop
stickeraantal = 0 'resetting number of stickers needed to zero for next row
Next row
End If
Next
Application.ScreenUpdating = True
End Sub
The first part, inserting extra sheets and adjusting to the sticker sizes, works in my sample file.
The second part, filling the stickers with the data, I can't get started.
I suspect I'm doing something wrong with declaring the range per header.
But whatever I adjust in it, the second part doesn't work and sometimes the first part doesn't either.