Sub Verteile()
Dim i As Long
Dim anfang As Long
Dim ende As Long
Dim suche
Dim suche2
Dim gefunden As Boolean
Application.ScreenUpdating = False
Set suche = Worksheets("Tabelle1").Columns(23).Find("A", lookat:=xlWhole, LookIn:=xlValues)
Set suche2 = Worksheets("Tabelle1").Columns(23).Find("B", lookat:=xlWhole, LookIn:=xlValues)
If suche Is Nothing And suche2 Is Nothing Then
anfang = 19
ende = 22
gefunden = True
Else
anfang = 10
ende = 22
gefunden = False
End If
With Tabelle1
For i = anfang To ende
Worksheets.Add After:=Sheets(Sheets.Count)
.UsedRange.Range("A:D").Copy ActiveSheet.Cells(1)
.UsedRange.Columns(i).Copy ActiveSheet.Cells(1, 5)
ActiveSheet.Name = Cells(1, 5)
If gefunden = True Then ActiveSheet.Name = Cells(1, 5) & "C"
Next
End With
End Sub