Möchte per Button meine Tabelle mit automatisch generierten Namen speichern

Sub MappeSpeichern()                ' nicht 'Save', das ist ein reserviertes Wort  
    MsgBox VZName                   ' nur zur Kontrolle, dann auskomm. oder löschen  
    ActiveWorkbook.SaveAs Filename:="C:\Users\" & VZName & "\Documents\Stunden.xlsm", _  
                          FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Private Function VZName() As String
    Dim i As Integer
    With ThisWorkbook
        For i = 1 To 12
            If .Sheets(i).Cells(1, 1).Value = 0 Then
                If i = 1 Then
                    VZName = .Sheets(i).Name
'                    VZName = "Keiner"  
                    Exit Function
                Else
                    VZName = .Sheets(i - 1).Name
                    Exit Function
                End If
            End If
        Next i
    End With
End Function

Sub MappeSpeichern()
    MsgBox "C:\Users\#####\Documents\Stunden " & FileNameToken & ".xlsm"  
    ActiveWorkbook.SaveAs Filename:="C:\Users\#####\Documents\Stunden " & FileNameToken & ".xlsm", _  
                            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Private Function FileNameToken() As String
    Dim i As Integer
    With ThisWorkbook
        For i = 1 To 12
            If .Sheets(i).Cells(1, 1).Value = 0 Then
                FileNameToken = IIf(i = 1, .Sheets(i).Name, .Sheets(i - 1).Name)     ' wie oben, kürzere Schreibweise  
                Exit Function
            End If
        Next i
    End With
End Function

ActiveWorkbook.SaveAs Filename:="C:\Users\#####\Documents\Stunden " & ActiveSheet.Name & ".xlsm"