AW: Das geht so doch nicht.
05.07.2006 17:06:35
Sylvio
Hallo Daniel,
noch paar Ergänzungen:
er prüft erst ob die 4 ersten Datenblätter + 16 Datenblätter vorhanden sind. Ansonsten kommt ne Meldung und er beendet.
Er überspringt das Sheet "Ziel" falls es in der Schleife auftaucht.
Sub Test()
first = 1
Application.DisplayAlerts = False
prüf = ThisWorkbook.Sheets.Count - 4
If prüf <= 16 Then
MsgBox "Sie haben keine 16 Datenblätter für die nachfolgende Schleife zur Verfügung!", vbCritical, "Hinweis"
Exit Sub
End If
For i = 1 To 16
If ThisWorkbook.Sheets(i).Name = "Ziel" Then i = i + 1
ThisWorkbook.Sheets(i).Activate
ThisWorkbook.Sheets(i).Range(ThisWorkbook.Sheets(i).Cells(1, 1), ThisWorkbook.Sheets(i).Cells(ThisWorkbook.Sheets(i).Cells(1, 1).End(xlDown).Row, 8)).Select
Selection.Copy
ThisWorkbook.Sheets("Ziel").Activate
If first = 1 Then
ThisWorkbook.Sheets("ziel").Cells(1, 1).Select
Selection.Insert
End If
If first = 2 Then
ThisWorkbook.Sheets("ziel").Cells(1, 1).End(xlDown).Offset(1, 0).Select
Selection.Insert
End If
first = 2
Next i
ThisWorkbook.Sheets("Ziel").Columns("B:B").Select
Range(ThisWorkbook.Sheets("Ziel").Cells(1, 1), ThisWorkbook.Sheets("Ziel").Cells(ThisWorkbook.Sheets("Ziel").Cells(1, 1).End(xlDown).Row, 8)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ThisWorkbook.Sheets("Ziel").Cells(1, 1).Select
Application.DisplayAlerts = True
End Sub
Gruß Sylvio