Hallo,

der folgende Code kann hilfreich sein:

Option Explicit

Dim OldWorksheetName As String

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngChk As Range, rngTarget As Range, sSheetName As String
    Dim wsh As Worksheet, wshNew As Worksheet
    With Target.Worksheet
        Set rngChk = .Range(.Range("D10"), .Cells(.UsedRange.Rows.Count + UsedRange.Row, 4))
        For Each rngTarget In Target.Cells
            If Not Intersect(rngTarget, rngChk) Is Nothing Then
                sSheetName = rngTarget.Cells(1, 1).Value
                If sSheetName = "" Then
                    ' gelöscht
                    If Not OldWorksheetName = "" Then
                        Set wshNew = GetWorksheet(ThisWorkbook, OldWorksheetName)
                        If Not wshNew Is Nothing Then
                            Application.DisplayAlerts = False
                            wshNew.Delete
                            Application.DisplayAlerts = True
                            OldWorksheetName = ""
                        End If
                    End If
                Else
                If Not OldWorksheetName = "" Then
                    ' Umbenennen
                    Set wshNew = GetWorksheet(ThisWorkbook, OldWorksheetName)
                    If Not wshNew Is Nothing Then
                        wshNew.Name = sSheetName
                    End If
                Else
                    Set wsh = GetWorksheet(ThisWorkbook, sSheetName)
                    If wsh Is Nothing Then
                        Template.Copy After:=Target.Worksheet
                        Set wshNew = SearchHiddenWorkbook(ThisWorkbook, Template)
                        wshNew.Name = sSheetName
                        wshNew.Visible = xlSheetVisible
                        wshNew.Activate
                    End If
                End If
                End If
            End If
        Next
    End With
End Sub

Private Function SearchHiddenWorkbook(wbk As Workbook, wshTemplate As Worksheet) As Worksheet
    Dim wsh As Worksheet
    For Each wsh In wbk.Worksheets
        If Not wsh.Visible = xlSheetVisible Then
            If Left(wsh.Name, Len(wshTemplate.Name)) = wshTemplate.Name Then
                Set SearchHiddenWorkbook = wsh
                Exit For
            End If
        End If
    Next
End Function

Private Function GetWorksheet(wbk As Workbook, sName As String) As Worksheet
    Dim wsh As Worksheet
    With wbk
        For Each wsh In wbk.Worksheets
            If wsh.Name = sName Then
                Set GetWorksheet = wsh
                Exit For
            End If
        Next
    End With
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rngChk As Range, rngTarget As Range
    Dim wsh As Worksheet, wshNew As Worksheet
    With Target.Worksheet
        Set rngChk = .Range(.Range("D10"), .Cells(.UsedRange.Rows.Count + UsedRange.Row, 4))
        For Each rngTarget In Target.Cells
            If Not Intersect(rngTarget, rngChk) Is Nothing Then
                OldWorksheetName = rngTarget.Value
            End If
        Next
    End With
End Sub

Dieser Code muss der  Tabelle zugewiesen werden, in dem in Spalte D die Tabellennamen eingegeben werden sollen.

Zusätzlich muss in der Arbeitmappe eine Tabelle mit dem Namen Template vorhanden sein.

Die Tabelle "Template" dient als Vorlage für die neu erstellen Tabellen.

Einschränkung: Die neu zu erstellenden Tabellen dürfen nicht den Namen Template haben!

Rückfragen einfach hier einstellen.

LG, Ben