Macro stopt niet bij lege cel

[bomseler]

Hallo,

Ik vul door middel van een macro een aantal rijen. Nou wil ik voor de ingevulde cellen in Range("A12:A") de macro in het blauw laten uitvoeren voor alle gevulde cellen. Daaropvolgend moet de macro in het rood de gevulde cellen een hyperlink geven naar het daarvoor gemaakte tabblad. Dit werkt allemaal, behalve dat als ik in mijn inputbox bijv. 5 invoer, dan word voor de ingevulde cellen een tabblad gemaakt, dat is goed, maar dan probeert de macro ook een tabblad voor de eerstvolgende lege cel te maken en hierdoor krijg ik het tabblad 'Sjabloon (2)' en een foutmelding omdat hiervan de naam niet gewijzigd kan worden.

Hoe kan ik de macro omzetten zodat de macro in het blauw x (aantal dat in de inputbox word ingevoerd) keer wordt uitgevoerd?

Ik hoop dat ik zo een beetje duidelijk ben.

Sub bnrs_toevoegen_2()

Dim x As Integer
Dim strLink As String
    
    x = InputBox("Geef hier het aantal bouwnummers van het project")
For numtimes = 1 To x - 1
    
Range("A12:Y12").AutoFill Range("A12:Y12").Resize(x)
    
[COLOR=#0000ff]With Sheets("BNR Overzicht")
    For Each cl In .Range("A12:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
        If Not WSExists(CStr(cl)) Then
            Sheets("Sjabloon").Copy , Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = "BNR" & " " & cl
        End If
    Next
End With
Next[/COLOR]

[COLOR=#ff0000]With Sheets("BNR Overzicht").Select
Range("a12").Select
While ActiveCell.Value <> ""
    strLink = "'BNR " & ActiveCell.Value & "'!A1"
    ActiveSheet.hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
      strLink, TextToDisplay:=ActiveCell.Value
    ActiveCell.Offset(1, 0).Select
Wend
End With
[/COLOR]
End Sub

[COLOR=#0000ff]Function WSExists(wsName As String) As Boolean
    On Error Resume Next
    WSExists = Worksheets(wsName).Name = wsName
End Function

[/COLOR]

 

[bomseler]

Opgelost door

For numtimes = 1 To x - 1
Next