Private Sub CommandButton1_Click()
    MsgBox "Добавление нового снека"
    Dim intx As Integer, Sh As Worksheet, Rng As Range
    intx = ThisWorkbook.Worksheets.Count
    Set Sh = ThisWorkbook.Worksheets("Меню")
    '1 Добавляем лист под аппарат
    LastRow = Sh.Cells(Sh.Rows.Count, 2).End(xlUp).Row + 1
    If LastRow < 6 Then LastRow = 6
    WName = WorksheetName
    Set Rng = Range("B" & LastRow).Resize(1, 2)
    With Rng
        .HorizontalAlignment = xlCenter
        .MergeCells = True
    End With
    Sh.Hyperlinks.Add Anchor:=Rng, Address:="", SubAddress:= _
                      WName & "!A1", TextToDisplay:=WName

    ThisWorkbook.Worksheets("Снек").Copy , after:=ThisWorkbook.Worksheets(intx)
    intx = ThisWorkbook.Worksheets.Count
    ThisWorkbook.Worksheets(intx).Name = WName
    Sh.Activate

End Sub
Function WorksheetName() As String
    Dim Sh As Worksheet, Count As Integer
    For Each Sh In ThisWorkbook.Worksheets
        If InStr(1, Sh.Name, "Снек", vbTextCompare) = 1 Then
            Count = Count + 1
        End If
    Next
    WorksheetName = "Снек" & Count
End Function