VBA: Tabelle verteilen
Hannoi
ich möchte gerne eine Tabelle nach ihren Einzelkriterien in Spalte 20 auf verschiedene Arbeitsblätter verteilen. Dies klappt auch ganz gut. Aber leider nur so lange, wenn die Datensätze mit dem Kriterium einzeln auftreten. Tritt unmittelbar zweimal dasselbe Kriterium hintereinander auf werden keine neuen Arbeitsblätter erzeugt. Über eine Hilfe würde ich mich sehr freuen.
Viele Grüße
Hannoi
Sub verteilen()
Dim ws As Worksheet, str As String
Dim i, Text
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 23 Step -1
str = Cells(i, 20)
On Error Resume Next
Set ws = Sheets(str)
If ws Is Nothing Then
Text = Cells(i, 20)
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Text
Worksheets("Tabelle1").Activate
End If
Next
For Each ws In Sheets
For i = Worksheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row To 23 Step -1
If ws.Name = Cells(i, 20) Then
Worksheets("Tabelle1").Cells(i, 20).EntireRow.Copy ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp) _
_
.Row + 1, 1)
End If
Next
Next
Application.ScreenUpdating = True
End Sub