Tabellenblatt übertragen

Sub Übertragen_Übersicht()
Dim wksAushänger As Worksheet, wksÜbersicht As Worksheet
Dim Zeile_1 As Long, Zeile_2 As Long
Const Spalte_X As Long = 1 'Spalte mit den x-Einträgen im Blatt "Aushänger"
Const ZeileTitel As Long = 4 'Zeile mit den Spaltentiteln im Blatt "Aushänger"
Set wksAushänger = Worksheets("Aushänger")
Set wksÜbersicht = Worksheets("Übersicht")
With wksÜbersicht
'Letzte Datenzeile im Blatt "Übersicht", als Spalte (hier 1) eine Spalte wählen, _
in der in jeder Zeile ein Wert eingetragen wird - z.B. Kundenname oder Kunden-Nr.
Zeile_2 = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
Application.ScreenUpdating = False
With wksAushänger
'Spalten mit Eintrag "x" unter Freigabe kopieren nach Blatt "Übersicht"
For Zeile_1 = ZeileTitel + 1 To .Cells(.Rows.Count, Spalte_X).End(xlUp).Row
If LCase(.Cells(Zeile_1, Spalte_X).Value) = "x" Then
Zeile_2 = Zeile_2 + 1
Rows(Zeile_1).Copy
wksÜbersicht.Cells(Zeile_2, 1).PasteSpecial Paste:=xlPasteValues
wksÜbersicht.Cells(Zeile_2, Spalte_X) = Date 'X-Eintrag durch aktuelles Datum ersetzen
End If
Next
Application.CutCopyMode = False
'Zeilen mit "x" von unten nach oben löschen
For Zeile_1 = .Cells(.Rows.Count, Spalte_X).End(xlUp).Row To ZeileTitel + 1 Step -1
If LCase(.Cells(Zeile_1, Spalte_X).Value) = "x" Then
.Rows(Zeile_1).ClearContents
End If
Next
End With
Application.ScreenUpdating = True
MsgBox "Fertig", vbInformation + vbOKOnly, "Übertragung nach Übersicht"
End Sub