AW: Fehler beim Kompilieren - Prozedur zu groß
07.04.2018 17:43:41
Claus
Hallo Gerd,
deine Idee habe ich genommen und wie folgt eingesetzt.
Sub RueberSAM()
'Daten von AB_SAM in DatenSAM
Dim i As Long, offs As Long
Dim Q As Worksheet, Z As Worksheet
Set Q = Sheets("DatenSAM"): Set Z = Sheets("Arbeitsblatt_SAM")
Application.ScreenUpdating = False
For i = 1 To 100
'StNr1
If Z.Cells(i, 1) = Q.Range("A7") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W7:Z7").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E7").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS7")
Z.Range("JL" & i) = Q.Range("BT7")
Z.Range("JM" & i) = Q.Range("Q7")
'BK
Z.Range("JN" & i) = Q.Range("BU7")
Z.Range("JO" & i) = Q.Range("BV7")
Z.Range("JP" & i) = Q.Range("BW7")
Z.Range("JQ" & i) = Q.Range("R7")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T7")
End If
'StNr2
If Z.Cells(i, 1) = Q.Range("A8") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W8:Z8").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E8").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS8")
Z.Range("JL" & i) = Q.Range("BT8")
Z.Range("JM" & i) = Q.Range("Q8")
'BK
Z.Range("JN" & i) = Q.Range("BU8")
Z.Range("JO" & i) = Q.Range("BV8")
Z.Range("JP" & i) = Q.Range("BW8")
Z.Range("JQ" & i) = Q.Range("R8")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T8")
End If
'StNr3
If Z.Cells(i, 1) = Q.Range("A9") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W9:Z9").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E9").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS9")
Z.Range("JL" & i) = Q.Range("BT9")
Z.Range("JM" & i) = Q.Range("Q9")
'BK
Z.Range("JN" & i) = Q.Range("BU9")
Z.Range("JO" & i) = Q.Range("BV9")
Z.Range("JP" & i) = Q.Range("BW9")
Z.Range("JQ" & i) = Q.Range("R9")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T9")
End If
'StNr4
If Z.Cells(i, 1) = Q.Range("A10") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W10:Z10").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E10").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS10")
Z.Range("JL" & i) = Q.Range("BT10")
Z.Range("JM" & i) = Q.Range("Q10")
'BK
Z.Range("JN" & i) = Q.Range("BU10")
Z.Range("JO" & i) = Q.Range("BV10")
Z.Range("JP" & i) = Q.Range("BW10")
Z.Range("JQ" & i) = Q.Range("R10")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T10")
End If
'StNr5
If Z.Cells(i, 1) = Q.Range("A11") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W11:Z11").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E11").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS11")
Z.Range("JL" & i) = Q.Range("BT11")
Z.Range("JM" & i) = Q.Range("Q11")
'BK
Z.Range("JN" & i) = Q.Range("BU11")
Z.Range("JO" & i) = Q.Range("BV11")
Z.Range("JP" & i) = Q.Range("BW11")
Z.Range("JQ" & i) = Q.Range("R11")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T11")
End If
'StNr6
If Z.Cells(i, 1) = Q.Range("A12") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W12:Z12").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E12").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS12")
Z.Range("JL" & i) = Q.Range("BT12")
Z.Range("JM" & i) = Q.Range("Q12")
'BK
Z.Range("JN" & i) = Q.Range("BU12")
Z.Range("JO" & i) = Q.Range("BV12")
Z.Range("JP" & i) = Q.Range("BW12")
Z.Range("JQ" & i) = Q.Range("R12")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T12")
End If
'StNr7
If Z.Cells(i, 1) = Q.Range("A13") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W13:Z13").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E13").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS13")
Z.Range("JL" & i) = Q.Range("BT13")
Z.Range("JM" & i) = Q.Range("Q13")
'BK
Z.Range("JN" & i) = Q.Range("BU13")
Z.Range("JO" & i) = Q.Range("BV13")
Z.Range("JP" & i) = Q.Range("BW13")
Z.Range("JQ" & i) = Q.Range("R13")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T13")
End If
'StNr8
If Z.Cells(i, 1) = Q.Range("A14") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W14:Z14").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E14").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS14")
Z.Range("JL" & i) = Q.Range("BT14")
Z.Range("JM" & i) = Q.Range("Q14")
'BK
Z.Range("JN" & i) = Q.Range("BU14")
Z.Range("JO" & i) = Q.Range("BV14")
Z.Range("JP" & i) = Q.Range("BW14")
Z.Range("JQ" & i) = Q.Range("R14")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T14")
End If
'StNr9
If Z.Cells(i, 1) = Q.Range("A15") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W15:Z15").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E15").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS15")
Z.Range("JL" & i) = Q.Range("BT15")
Z.Range("JM" & i) = Q.Range("Q15")
'BK
Z.Range("JN" & i) = Q.Range("BU15")
Z.Range("JO" & i) = Q.Range("BV15")
Z.Range("JP" & i) = Q.Range("BW15")
Z.Range("JQ" & i) = Q.Range("R15")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T15")
End If
'StNr10
If Z.Cells(i, 1) = Q.Range("A16") Then
'WP1- 'SZ12
For offs = 0 To 11
Z.Cells(i, 198).Offset(0, (offs * 6)) = Q.Range("W5").Offset(0, offs * 6)
Z.Cells(i, 199).Resize(1, 4).Offset(0, offs * 6) = Q.Range("W16:Z16").Offset(0, offs * 6)
Z.Cells(i, 203).Offset(0, offs * 6) = Q.Range("E16").Offset(0, offs * 6)
Next
'SP
Z.Range("JJ" & i) = Q.Range("BS5")
Z.Range("JK" & i) = Q.Range("BS16")
Z.Range("JL" & i) = Q.Range("BT16")
Z.Range("JM" & i) = Q.Range("Q16")
'BK
Z.Range("JN" & i) = Q.Range("BU16")
Z.Range("JO" & i) = Q.Range("BV16")
Z.Range("JP" & i) = Q.Range("BW16")
Z.Range("JQ" & i) = Q.Range("R16")
'Gesamt Pkt
Z.Range("JR" & i) = Q.Range("T16")
End If
Next i
Set Q = Nothing: Set Z = Nothing
Application.ScreenUpdating = True
End Sub
Aber es funktioniert nicht - wahrscheinlich habe ich beim Transfer einen Fehler gemacht.
LG
Claus