Hilfe bei Codeanpassung

Option Explicit
Sub prcStart()
Dim iWeek
iWeek = Application.InputBox("Week?" & vbLf & "99 for all Weeks", "Eingabe", , , , , , 1)
Select Case iWeek
Case False
Case 1 To 53, 99: prcDaten iWeek
End Select
End Sub
Sub prcDaten(ByVal iWeek As Integer)
Dim oDaten As Object, lngRow As Long, lngC, arrSheets, mySheet
Dim arrItems(1 To 20), arrWeeks, myWeek, arrTmp, i As Integer
Set oDaten = CreateObject("Scripting.Dictionary")
arrSheets = Array("Auto", "Motorräder")  'nach Bedarf erweitern
If iWeek = 99 Then
arrWeeks = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Sheets(arrSheets(0)). _
Range("B2:BA2"))) 'anpassen
Else
arrWeeks = Array(iWeek)
End If
For Each myWeek In arrWeeks
For Each mySheet In arrSheets
With Sheets(mySheet)
lngC = Application.Match(myWeek, .Rows(2), 0)
If Not IsError(lngC) Then
For lngRow = 20 To .Cells(Rows.count, 1).End(xlUp).Row Step 17
arrTmp = Split(.Cells(lngRow, 1), ">")
arrItems(1) = myWeek
arrItems(2) = arrTmp(0)
If UBound(arrTmp) > 0 Then
arrItems(3) = arrTmp(1)
End If
arrItems(4) = .Cells(lngRow, 1)
For i = 5 To 20
arrItems(i) = .Cells(lngRow + i - 4, lngC)
Next
oDaten(.Cells(lngRow, 1).Value & "_" & myWeek) = arrItems
Next
End If
End With
Next
Next myWeek
If oDaten.count > 0 Then
Application.ScreenUpdating = False
With Sheets("TotalsRaw")
.Cells(Rows.count, 1).End(xlUp).Offset(1).Resize(oDaten.count, 20) = _
WorksheetFunction.Transpose(WorksheetFunction.Transpose(oDaten.items))
End With
End If
End Sub