Excel 2010 - per VBA definierte Range verschieben

[Surtia]

Ich habe ein Mini-Makro getippt, was mir die Anzahl der ausgefüllten Zellen eines bestimmten Bereichs eines Registerblatts ausgibt. In diesem Fall wird die Anzahl der Zeile 1 von A-H in die Zelle J1 ausgegeben.

Sub Anzahl()
Dim Range As Range

For i = 1 To Sheets.Count
    Set ZRB = ThisWorkbook.Sheets(i)
    Set Range = ZRB.Range("A1:H1")
    k = Application.WorksheetFunction.CountA(Range)
    ZRB.Range("J1") = k
Next
End Sub

Auszug aus Excel-Tabelle Registerblatt 1

	A	B	C	D	E	F	G	H	I	J
1	10	20	Hi	40	70	99				6
2
3
4	11	Hugo	Test	100
5
6
7	Müll	22	44	66	Welt	3000	20
8

Wie im Beispiel zu erkennen ist habe ich 3 Bereiche (Zeile 1, 4 und 7) in beiden Registerblätter.
Ich möchte, dass die Range für jeden Durchlauf um 3 Zeilen weiter rückt.
Jedoch nicht über eine If-Anweisung, die im ersten Durchlauf ("A1:H1") festsetzt, dann ("A4:H4") und zuletzt ("A7:H7").
Wie kann ich das realisieren?
Leider bin ich bisher nicht fündig geworden.

 

[Scientist]

In dem du den Zellbereich ueber .Range mit zwei .Cells' definierst und dann ganze in eine weitere Schleife packst.
.Range(.Cells(1 + Step, 1), .Cells(1 + Step, 8))

 

[Surtia]

Diese Schreibweise ist mir bekannt und habe ich auch schon versucht.
Erstmal ohne die Zeile hochzuzählen, was im nächsten Schritt recht einfach ist.

Sub zählen()
Dim Range As Range

For i = 1 To Sheets.Count
    Set ZRB = ThisWorkbook.Sheets(i)
    Set Range = ZRB.Range("A1:H1")
    'Set Range = ZRB.Range(Cells(1, 1), Cells(1, 8))
    k = Application.WorksheetFunction.CountA(Range)
    ZRB.Cells(1, 10) = k
Next
End Sub

Aktiviere ich die auskommentierte Zeile 7 und deaktiviere Zeile 6, wird mir der Laufzeitfehler 1004 ausgepuckt.
"Anwendungs- oder objektdefinierter Fehler"

Der kommt mit dem Index i nicht klar. Setze ich i in Zeile 5 auf eine 1 oder 2 klappt es, aber das ist nicht das Ziel.
Die Registerblätter müssen durchgezählt werden.

Habe die Datei inkl. Makro angehangen.

 

[Scientist]

.Cells muss auch auf das neue Blatt verweisen werden muss ...
Deswegen bin ich kein Fan von dieser Schreibweise.

Set Range = ZRB.Range(ZRB.Cells(1, 1), ZRB.Cells(1, 8))

Dann lieber mit With

with ZRB
    Set Range = .Range(.Cells(1, 1), .Cells(1, 8))
End With

 

[cumulonimbus8]

Mal ganz dumm: 3 leere Zeilen oben einfügen.
CN8

 

[Surtia]

@cumulonimbus8
KA was du genau meinst.

@Scientist
Danke Dir!

Leider war noch ein zusätzlicher Fehler in meinem Makro drin.
"Dim Range As Range" funktioniert nicht. Irgendwie kommt er mit der Objektvariable nicht klar.

Im Anhang die fertige Datei inkl. Code, falls zukünftig wer selbigen Wunsch hat.

Sub zählen()
Dim R As Range

For i = 1 To Sheets.Count
    Set ZRB = ThisWorkbook.Sheets(i)
    k = 0
    For j = 0 To 2 'Zeilen durchlaufen
        Set R = Range(ZRB.Cells(1 + k, 1), ZRB.Cells(1 + k, 8))
        l = Application.WorksheetFunction.CountA(R)
        ZRB.Cells(1 + k, 10) = l
        k = k + 3
    Next
Next
End Sub

 

[cumulonimbus8]

KA was du genau meinst.

Mir fehlen die Wörter diese einfache Idee anders zu auszuformulieren.

So weit ich das erkenne soll alles um 3 Zeilen abwärts.
(A) alles ausschneiden und 3 Zeilen tiefer einkleben…
(B) einfach ganz oben 3 Leerzeilen einfügen…
Das Resultat sollte dasselbe sein.

Sub yyRangeKopieren()
Worksheets("Blatt4").Range(Worksheets("Blatt4").Cells(1, 12), _
Worksheets("Blatt4").Cells(21, 12)) = _
Worksheets("Blatt5").Range(Worksheets("Blatt5").Cells(1, 4), _
Worksheets("Blatt5").Cells(21, 4)).Value
End Sub

Nun muss man nur die hart kodierten »Ecken« durch reale Werte und etwas Mathematik (›plus 3‹) ersetzen…

Sub yyLetzteZeileAnspringen()
 'hier erfasse ich Spalte B deren unteres Ende man sucht'
 Debug.Print ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
End Sub
'Für Spalten ersetzt man Row sinngemäß durch Column.''

Mit diesen Beispielen sollte man ein intelligentes Makro zaubern können.

CN8