Office: (Office 365) Blattnamen in neue Arbeitsmappe übernehmen

Hallo,

ich bin totale VBA-Anfängerin und stehe vor folgendem Problem: ich würde gerne ausgehend von einer vorhandenen Arbeitsmappe (XY) eine neue erstellen und in der neuen Arbeitsmappe (XYZ) die gleiche Anzahl und Benennung an Arbeitsblättern haben wie in der vorhandenen Mappe (XY) ohne die Daten der Blätter zu übernehmen. Ist das möglich?

 

Hallo Sterni

Trage folgenden Code in ein Modul deiner Arbeitsmappe, welche du ohne Inhalt aber mit allen Arbeitsblättern und Blattnamen neu anlegen willst:

Code:

Option Explicit
Dim arrBlattnamen

Sub BlattnamenInArray()
    Dim Wks As Worksheet, Tbl_Blatt() As String, i As Integer
    For Each Wks In ThisWorkbook.Worksheets
        ReDim Preserve Tbl_Blatt(i)
        Tbl_Blatt(i) = Wks.Name
        i = i + 1
    Next Wks
    ReDim arrBlattnamen(i - 1)
    For i = LBound(Tbl_Blatt) To UBound(Tbl_Blatt)
        arrBlattnamen(i) = Tbl_Blatt(i)
    Next i
End Sub

Sub NeuesWorkbookAlleBlattnamen()
    Dim strFilename As String, strFilenameM As String, i As Integer
        BlattnamenInArray
        strFilename = InputBox("Bitte den Namen der Neuen Datei angeben")

        strFilenameM = ThisWorkbook.Name

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Workbooks.Add
    ActiveWindow.Caption = strFilename
    Windows(strFilename).Activate

    With Windows(strFilename)
        ActiveSheet.Name = arrBlattnamen(0)
        For i = 1 To UBound(arrBlattnamen)
            Sheets.Add
            ActiveSheet.Name = arrBlattnamen(i)
        Next i
    End With
        
    With Application.FileDialog(msoFileDialogSaveAs)
        .FilterIndex = 2 'Filterindex 1 ist .xlsx und 2 ist .xlsm
        .InitialFileName = strFilename
        If .Show = -1 Then
            .Execute
        Else
            MsgBox "Es wurde Abbrechen gedrückt!"
        End If
    End With
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
End Sub

Die Sub "NeuesWorkbookAlleBlattnamen" erledigt das Alles.
Anbei noch eine Beispieldatei
Gruß Uwe

 

Cool, vielen lieben Dank für die schnelle Antwort! :)

 

Gerne