Extra blad toevoegen

[Johande]

Beste Mensen,

Ik heb een code aangepast van Vena.
Om automatisch een blad toe te voegen als deze vol is en daar op nieuw boven aan te beginnen.
Maar nu kiest het toch automatisch elke keer het eerste blad.

Kan er iemand eens kijken wat ik verkeerd doe?

gr, Johande

 

[HiHans]

Hallo Johande,

Er gaat iets fout in dit stukje code.
x = 1
wsl.Copy , wb.Sheets(1)
Set wslt = wb.Sheets(1)
wslt.Visible = xlSheetVisible

Als ik hier, in de rode tekst, van de 1 een 2 maakt, dan wordt het 2e stickervel gevuld.

Je zult dus ook een tellertje in moeten bouwen voor het sheet nummer.

 

[VenA]

Sub VenA()
  Dim j As Long, c00 As String, c01 As String, ar, d
  ar = Sheets("Sticker").Cells(1).CurrentRegion
  Set d = CreateObject("Scripting.Dictionary")
  Sheets("Stikker(1)").Copy
  For j = 1 To UBound(ar) Step 2
    c00 = ar(j, 1) & "-" & ar(j, 2) & "stuks-" & ar(j, 5) & "-" & ar(j, 6) & "-" & ar(j, 7)
    If j = UBound(ar) And UBound(ar) Mod 2 = 1 Then c01 = "" Else c01 = ar(j + 1, 1) & "-" & ar(j + 1, 2) & "stuks-" & ar(j + 1, 5) & "-" & ar(j + 1, 6) & "-" & ar(j + 1, 7)
      d(ar(j, 1)) = Array(c00, c01)
      If (j + 1) Mod 18 = 0 Or j = UBound(ar) Then
        Sheets(Sheets.Count).Cells(1).Resize(d.Count, 2) = Application.Index(d.items, 0, 0)
        If j <> UBound(ar) Then
          Sheets(1).Copy , Sheets(Sheets.Count)
          Cells.ClearContents
          d.RemoveAll
        End If
      End If
    Next j
End Sub

 

[Johande]

Bedankt allemaal voor de reactie.
VenA dank voor de oplossing.

:thumb: