Sub Verteile()
Dim i As Long
Dim anfang As Long
Dim ende As Long
Dim suche
Dim gefunden As Boolean
Application.ScreenUpdating = False
suche = Application.WorksheetFunction.Match("C", Worksheets("Tabelle1").Columns(3), 0)
If suche = "#N/A" Then
anfang = 10
ende = 22
gefunden = False
Else
anfang = 19
ende = 22
gefunden = True
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