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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen