Daten sortieren und eintragen
11.01.2006 13:59:47
Dominik
Ich habe letztens schonmal einen Thread eröffnet, in dem es darum ging, Tabellenblätter zu erstellen (Spalte B nach Zahlen auslesen und für jede Zahl ein Blatt erstellen und sortieren). Habe diesen Code hier:
Nun hänge ich aber daran, einen Schritt weiter zu gehen, Nachdem die Blätter erstellt und sortiert wurden und ein Autofilter in Zeile1 aufgesetzt wurde, welcher die Spalte C nach "E" filtert.
Folgendes sollte in den Code ergänzt werden:
Nach dem unten stehenden Code soll der Autofilter Spalte B (in der die Zahlen stehen) jede einzelne Zahl durchgehen und alle Zellen, die dann nicht vom Filter gefiltert wurden, in das jeweilige, zur Zahl gehörende Blatt kopieren.
Nur wie gesagt, ich komme leider nicht voran...
Hier der Code:
Sub TabErzeugen()
Dim lngI As Long, lngN As Long
Dim bolSchonDa As Boolean
Dim iMax, Ibl, Ibl2 As Integer
On Error Resume Next
Application.DisplayAlerts = False
Sheets(2).Delete
Sheets(2).Delete
Application.DisplayAlerts = True
On Error GoTo 0
For lngI = 1 To Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
bolSchonDa = False
For lngN = 1 To Sheets.Count
If Sheets(lngN).Name = "WS_" & Sheets(1).Cells(lngI, 2).Value Then bolSchonDa = True
Next lngN
If bolSchonDa = False Then
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "WS_" & Sheets(1).Cells(lngI, 2).Value
End If
Next lngI
Application.ScreenUpdating = False
iMax = ActiveWorkbook.Worksheets.Count
For Ibl = 1 To iMax
For Ibl2 = Ibl To iMax
If UCase(Worksheets(Ibl2).Name) _
< UCase(Worksheets(Ibl).Name) Then
Worksheets(Ibl2).Move before:=Worksheets(Ibl)
End If
Next Ibl2
Next Ibl
Application.ScreenUpdating = True
Worksheets("Tabelle1").Select
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="E"
End Sub
Vielen Dank im Voraus!
Gruß, Dominik