Macro velden kopieren

[Vanuthov]

Goedendag,

 

Ik ben bezig om een macro te maken in Excel om twee cellen te kopiëren naar onderen om de lege cellen te vullen met dezelfde inhoud. Daarna moet het, met CTRL-End, naar de laatste van die velden (wat een andere inhoud heeft), dan moet hij het zelfde uitvoeren tot einde van het bestand. Wat ik via de macrorecorder heb is het volgende:

 

Range("A40:B40").Select
    Selection.AutoFill Destination:=Range("A40:B46")
    Range("A40:B46").Select
    Selection.End(xlDown).Select

 

Het aantal lege regels is variabel vandaar dat ik Selection.AutoFill Destination gebruik, echter moet het niet steeds dezelfde cellen vullen. De bedoeling is dat de laatste twee cellen weer gekopieerd worden naar de lege cellen daaronder enz.

 

Hoe kan ik dit voor elkaar krijgen?

Bij voorbaat dank voor het meedenken.

Groet,

Frans

Test.xlsm

[alpha]

Je wil A40:B40 (als dat wat in staat, maar die cellen zijn nu leeg) kopiëren naar beneden t/m A46:B46, zover begrijp ik het nog. Voor het overige kan ik je niet volgen.

13 februari 2018 aangepast door alpha

[Vanuthov]

Dank voor de reactie.

wat ik wil is cel A2 (Gebruiker 1) en B2 (Gebruiker.1) selecteren, door kopiëren naar onderen (dat kan door op de hoek rechtsonder te klikken waardoor de inhoud van die twee cellen wordt gekopieerd naar de lege cellen eronder), dan moet je met END-Pijltje naar beneden naar de onderste gevulde regel, in test.xlsx naar cel A9 (Gebruiker 2). Vanaf cel A9 moet dezelfde handeling plaatsvinden en daarna weer naar de volgende net zolang tot de laatste cel. Het probleem is dat je niet weet hoeveel lege regels er zijn het kunnen er 1 tot x-aantal zijn, vandaar het klikken op de hoek rechtsonder van de selectie. Als ik Range("A2:B2").Select en dan Selection.AutoFill Destination:=Range("A2:B8") gebruik zal hij alleen de range A2:B2 blijven selecteren en zal het nooit naar het volgende blok gaan, laat staan het hele document doorlopen.

Test.xlsm

14 februari 2018 aangepast door Vanuthov
Toevoegen bestand

[alpha]

Opmerking vooraf: een gewone macro zoals voor deze toepassing hoort in een module en niet in blad1.

Sub macro1()
Dim x As Integer
x = 3
With Sheets(1)
Do Until x = .Range("c" & .Rows.Count).End(xlUp).Row + 1
If Not IsEmpty(.Range("a" & x)) Then x = x + 1
.Range("a" & x - 1 & ":b" & x - 1).Copy .Range("a" & x)
x = x + 1
Loop
End With
End Sub

 

[Vanuthov]

Heel veel dank, Alpha, de macro werkt geweldig.

 

Groet, Frans

14 februari 2018 aangepast door Vanuthov

[kweezie wabbit]

Dan gaan wij er van uit dat je probleem is opgelost en sluiten we de vraag.

Succes nog.