Beim kopieren...

Einen schönen Sonntag liebes Forum,
irgendwie komme ich noch nicht so ganz mit dem Forum klar, mein Beitrag wird nicht mehr unter "Noch Offen" angezeigt! Da sich nun aber auch die Frage etwas geändert hat, und ich mich nun die letzten Tage natürlich beschäftigt habe,
habe ich es einigermassen hinbekommen das ich fast sagen kann das ich glücklich verliebt bin in mein Makro...
Wo ich noch scheiter ist das nur Sheets mit dem namen "RE" kopiert werden (also RE1,RE2,RE3... ) da ich in dem Workbook auch Sheets mit anderen namen habe, die werden aber leider alle mitkopiert!

' **********************************************************************
' Kopiert den Range A24:H51 in das Blatt Kilometer
Option Explicit
Public Sub kilometer()
Worksheets("Kilometer").Cells.ClearContents
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 <> "Archive"
lRow = shArc.Range("A" & Rows.Count).End(xlUp).Row + 1
sh.Range("A24:H51").Copy
shArc.Range("A" & lRow).PasteSpecial
End Select
Next
Application.CutCopyMode = False
Set shArc = Nothing
Set sh = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
.DisplayAlerts = True
.StatusBar = False
Sheets(1).Activate
End With
End Sub