besteht die Möglichkeit aus einer Tabelle einzelne Blätter zu erstellen.
In Spalte B sind verschiedene Namen, jetzt würde ich gern für jeden ein einzelnes eigenes Datenblatt erstellen.
LG
Option Explicit
Sub erstelleTabs()
Dim x
For x = 1 To 3 'Anpassen
Worksheets.Add.Name = Tabelle1.Cells(x, 2).Value
Next
End Sub
Es müsste dann noch eine Fehlerbehandlung rein,
Option Explicit
Sub Tabellen_erstellen()
Dim i As Long
Dim lastRow As Long
Dim sheetName As String
Dim ws As Worksheet
Application.ScreenUpdating = False
With Worksheets("Tabelle1") ' anpassen
On Error Resume Next
.ShowAllData
On Error GoTo 0
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("B2:B" & lastRow).Copy .Range("Z1")
.Range("Z1:Z" & lastRow).RemoveDuplicates Columns:=1, Header:=xlNo
For i = 1 To .Cells(.Rows.Count, "Z").End(xlUp).Row
.Range("A1").AutoFilter field:=2, Criteria1:=.Cells(i, "Z")
Worksheets.Add After:=Worksheets(Worksheets.Count)
.AutoFilter.Range.Copy ActiveSheet.Range("A1")
sheetName = .Cells(i, "Z")
For Each ws In ThisWorkbook.Worksheets
If ws.Name = sheetName Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
ActiveSheet.Name = sheetName
Next i
.Range("B1").AutoFilter
.Columns("Z").ClearContents
End With
Application.ScreenUpdating = True
End Sub