Erste zeile Löschen!

Public Sub kilometer()
Worksheets("Kilometer").Cells.Clear
With Application
.ScreenUpdating = False
.Application.AskToUpdateLinks = False
.EnableEvents = False
.Calculation = xlManual
.DisplayAlerts = False
End With
Dim lRow As Long
Dim sh As Worksheet
Dim shArc As Worksheet
Set shArc = ThisWorkbook.Worksheets("Kilometer")
For Each sh In ThisWorkbook.Worksheets
Select Case sh.Name
Case Is  "Kilometer"
If Left(sh.Name, 2) = "RE" Then
lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row + 1
sh.Range("A24:H51").Copy
shArc.Range("A" & lRow).PasteSpecial xlPasteValues
shArc.Range("A" & lRow).PasteSpecial xlPasteFormats
End If
End Select
Next
Application.CutCopyMode = False
Set shArc = Nothing
Set sh = Nothing

    Sheets("Kilometer").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
.DisplayAlerts = True
.StatusBar = False
Sheets(1).Activate
End With
End Sub