Knop/link naar nieuw tabblad plaatsen op overzichtblad met vba

[bomseler]

Beste,

Ik heb een hoofdblad gemaakt met een knop waarmee ik rijen op het hoofdblad toevoeg en nieuwe tabbladen toevoeg.

Nu heb ik 1 fout, als ik bijvoorbeeld invoer dat ik 5 tabbladen toe wil voegen wordt het sjabloonblad nog 1 keer teveel gekopieerd waardoor er een foutmelding ontstaat.

Sub bnrs_toevoegen_2()

Dim x As Integer
    
    x = InputBox("Geef hier het aantal nummers van het project")
    For numtimes = 1 To x - 1
    
Range("A12:G12").AutoFill Range("A12:G12").Resize(x)
    
With Sheets("Klantoverzicht")
    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
End Sub

Function WSExists(wsName As String) As Boolean
    On Error Resume Next
    WSExists = Worksheets(wsName).Name = wsName
End Function

Daarnaast wil ik dat de nummers in kolom A op het overzichtsblad een link/knop worden naar het aangemaakte blad met datzelfde nummer, hier kom ik niet uit.

Kan iemand mij hierbij helpen?

Alvast hartelijk dank,

Jeroen

Bekijk bijlage Helpmij_link naar tabblad.xlsm

 

[bomseler]

Opgelost

Ik heb het verhaal met de links bijna opgelost. Deze code gebruik ik nu ongeveer (ander bestand)

Sub Hyperlink()
'
'
Dim strLink As String
'
    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 Sub

Misschien heeft iemand hier nog wat aan. De foute kopie heb ik nog niet opgelost.