Dubbele loop

[Shortish]

Hallo Allen,

Ik ben bezig met een script waarmee ik gegevens automatisch laat aanvullen vanuit een ander tabblad. Ik ben inmiddels zo ver dat hij de eerste rij volledig aanvult. Nu wil ik alleen wanneer de eerste rij volledig is gevuld dat hij automatisch verder gaat met de tweede rij. Hieronder heb ik mijn script geplaatst ter verduidelijking.

Je ziet dat ik een tweede loop heb geprobeerd, maar dat kan dus niet. Heeft iemand suggesties hoe ik deze uitdaging de baas kan zijn?

Sub test2()

Sheets("Blad3").Select
Cells(21, 8).Select
x = ActiveCell.Column
y = ActiveCell.Row

'MsgBox x

'Do Until c = 16

jaar = Cells(1, x).Value
maand = Cells(2, x).Value

Do Until sectie = 1

x = ActiveCell.Column
y = ActiveCell.Row
sectie = Cells(y, 3).Value
'If sectie Is Empty Then

Sheets(jaar).Select
Columns(2).Select
Selection.Find(What:=sectie, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, maand + 1).Select
Selection.Copy
Sheets("blad3").Select
ActiveCell.PasteSpecial xlPasteValues
ActiveCell.Offset(1, 0).Select

' Else

'ActiveCell.Offset(1, 0).Select

Loop

c = x + 1

Cells(21, c).Select



'Loop



End Sub

 

[Shortish]

Allen,

Ik heb inmiddels een eenvoudige oplossing gevonden. Wat ik heb gedaan is het volgende.

"De sub die ik vermeld heb ik mijn vraag heb ik voor 98% gehouden. Het enige wat ik er heb uitgehaald zijn de eerste twee regels en die heb ik neergezet in een nieuw script. In dit nieuwe script heb ik een nieuwe loop aangemaakt wat eigenlijk de eerste sub activeert"

In ieder geval bedankt.

Sub test3()

Sheets("Blad3").Select
Cells(21, 8).Select

Do Until g = 17

test2
g = ActiveCell.Column

Loop

End Sub

 

[Warme bakkertje]

Als je een voorbeeldbestandje zou plaatsen met de nodige uitleg lijkt het mij dat deze code veel simpeler en vlotter kan gemaakt worden.