Alles klar. Teil 1 passt jetzt. Es hat ein Punkt vor Rows in der Zeile 44 gefehlt.
So sieht mein Code (Teil 1) aus:
Sub Tuncer_Teil_1()
Dim wksQuelle As Worksheet
Dim wks As Worksheet
Dim i As Integer
Dim Ueberschriften(4) As String
Dim lngLetzteZeile As Long
Dim lngZaehler As Long
' Überschriften ins Array
Ueberschriften(0) = "DATUM"
Ueberschriften(1) = "STRING 1"
Ueberschriften(2) = "STRING 2"
Ueberschriften(3) = "STRING 3"
Ueberschriften(4) = "STRING 4"
' Quellblatt kopieren
Set wksQuelle = ThisWorkbook.Worksheets("Tabelle1")
wksQuelle.Copy After:=Sheets(Sheets.Count)
' Zielblatt benennen und auswählen (ggf. unnötig)
Sheets(Sheets.Count).Name = "Kopie" & Sheets.Count
Set wks = Sheets("Kopie" & Sheets.Count)
With wks
.Select
' Zeilen Auswählen und nach Datum sortieren
lngLetzteZeile = .Cells(Rows.Count, 1).End(xlUp).Row
With .Sort
.SortFields.Clear
' zunächst nach Spalte A, danach nach Splate B sortieren
.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("B1" & lngLetzteZeile), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A2:D" & lngLetzteZeile)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' Zwischen den Zeilen jeder Datumsklasse eine Leere Zeile einfügen
For lngZaehler = lngLetzteZeile To 3 Step -1
If .Cells(lngZaehler, 1).Value <> .Cells(lngZaehler - 1, 1) Then
.Rows(lngZaehler).Select
' 1 Zeile einfügen, dabei Überschrift einsetzen
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For i = 0 To 3
.Cells(lngZaehler, i + 1).Value = Ueberschriften(i)
Next i
' 1 Trennzeile einfügen
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next lngZaehler
End With
Set wks = Nothing
Set wksQuelle = Nothing
End Sub
|