Wie baue ich das als Schleife?

Hallo zusammen,
ich habe folgendes Makro:


Private Sub Worksheet_Activate()
Dim i As Integer
Dim Zelle As Range, Bereich As Range
Set Bereich = Worksheets("Spielerausw.").Range("A1")
With Worksheets("Spieltagausw.")
For Each Zelle In Bereich
For i = 3 To 16 '*** soviele Zellen in 'Spieltagausw.' ***
If Zelle.Value = .Cells(i, 1).Value Then
.Range("C" & i & ":AL" & i).Copy Destination:=Zelle.Range("B3")
Exit For
End If
Next i
Next Zelle
For Each Zelle In Bereich
For i = 21 To 34 '*** soviele Zellen in 'Spieltagausw.' ***
If Zelle.Value = .Cells(i, 1).Value Then
.Range("C" & i & ":AL" & i).Copy Destination:=Zelle.Range("B4")
Exit For
End If
Next i
Next Zelle
For Each Zelle In Bereich
For i = 57 To 70 '*** soviele Zellen in 'Spieltagausw.' ***
If Zelle.Value = .Cells(i, 1).Value Then
.Range("C" & i & ":AL" & i).Copy Destination:=Zelle.Range("B6")
Exit For
End If
Next i
Next Zelle
For Each Zelle In Bereich
For i = 651 To 664 '*** soviele Zellen in 'Spieltagausw.' ***
If Zelle.Value = .Cells(i, 1).Value Then
.Range("C" & i & ":AL" & i).Copy Destination:=Zelle.Range("B39")
Exit For
End If
Next i
Next Zelle
For Each Zelle In Bereich
For i = 669 To 682 '*** soviele Zellen in 'Spieltagausw.' ***
If Zelle.Value = .Cells(i, 1).Value Then
.Range("C" & i & ":AL" & i).Copy Destination:=Zelle.Range("B40")
Exit For
End If
Next i
Next Zelle
End With
End Sub

Das Problem ist, das das Makro so schon lang ist, darauf folgen noch 20 solcher Bereiche:
Set Bereich = Worksheets("Spielerausw.").Range("A45")
For i bleibt wie im Makro oben (3 bis 682)


.Range("C" & i & ":AL" & i).Copy Destination:=Zelle.Range("B40")

Die Zielzellen sind für diesen Bereich
B47 bis B84
Set Bereich = Worksheets("Spielerausw.").Range("A89")
For i bleibt wie im Makro oben (3 bis 682)


.Range("C" & i & ":AL" & i).Copy Destination:=Zelle.Range("B40")

Die Zielzellen sind für diesen Bereich
B91 bis B128
Der letzte Bereich ist:
Set Bereich = Worksheets("Spielerausw.").Range("A837")
For i bleibt wie im Makro oben (3 bis 682)


.Range("C" & i & ":AL" & i).Copy Destination:=Zelle.Range("B40")

Die Zielzellen sind für diesen Bereich
B839 bis B876
Es geht um das Blatt Spielerauswertung in dieser Mappe, falls das zur Lösung beitragen kann:
http://vflgladbeck.onpw.de/Excel/Spielauswertungsbogen.zip
Es wäre auch gut, wenn man es so machen kann, das der erste Bereich bearbeitet wird, wenn Zelle G,22 im Tabellenblatt Datenerfassung=1 ist der zweite Bereich bei =2 usw. bis Bereich 20 bei Zelle G,22=20
PW: 123
Gruß Kai

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo zusammen,
leider konnte mir bsher ja noch niemand helfen, deshalb hier nochmal der gesamte Code.
Es wäre schön wenn jemand das Code Wirrwarr in Schleifen ordnen könnte.


Sub Torwart1()
Dim i As Integer
Dim Zelle As Range, Bereich As Range
Dim intT As Integer
intT = Sheets("Datenerfassung").Cells(23, 3)             ' Anz. Torhüter
If intT


Sub Torwart2()
Dim i As Integer
Dim Zelle As Range, Bereich As Range
Dim intT As Integer
intT = Sheets("Datenerfassung").Cells(23, 3)             ' Anz. Torhüter
If intT


Sub Torwart3()
Dim i As Integer
Dim Zelle As Range, Bereich As Range
Dim intT As Integer
intT = Sheets("Datenerfassung").Cells(23, 3)             ' Anz. Torhüter
If intT


Sub Torwart4()
Dim i As Integer
Dim Zelle As Range, Bereich As Range
Dim intT As Integer
intT = Sheets("Datenerfassung").Cells(23, 3)             ' Anz. Torhüter
If intT

Viele Grüße Kai

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread