lege regels invoegen

[Jansap]

Hallo

Ik heb een eigenlijk hele simple vraag maar kan er niet echt uit komen.
In bijgaande excel bestand zie je een aantal regels data.
Nu moet er op elke regel met een nummer in de cel 2 lege regels ingevoegd worden.
Ik heb het nu opgelost door dit met een macro te doen die ik opgeneomen heb en de code uitgebreid tot 100 regels. Maar ik krijg nu sheets met meer dan 100 regels en dat is niet echt te doen knippen en plakken met het handje. Ik weet dat je dit in een for next lus kan alleen kom ik er niet uit.

Als er overal twee regels tussen staan kan er bij kolom a 1 kolom ingevoegd worden en moeten er nog teksten in gezet worden. (zie voorbeeld)

Het eind resultaat staat er onder.

Misschien dat er iemand is die mij uit de brand kan helpen door mij weer op weg te laten gaan. als ik eenmaal het lus systeem weer zie kan ik het misschien wel weer verder.

hartelijk voor de moeite.

Jan

 

[mcs51mc]

Is dit de stappenplan?
Eén kolom links van kolom A invoegen
Doorloop alle rijen met data en voer volgende code uit
A) Als er iets in kolom B staat, twee rijen onderaan invoegen
B) Diezelfde rij "tlst" in kolom A zetten
C) Eén rij lager "oper" in kolom A zetten
D) Eén rij lager "mapc" in kolom A zetten
E) Terug naar A als dit niet de laatste rij was

Nu heb ik wel volgende vragen:
1) Als je de code voor de tweede keer runt, zal er terug een kolom vóór kolom A ingevoegd worden. Dat zal wel niet de bedoeling zijn of toch?

2) Voeg je die twee rijen toe aan de originele data of maak je een copie x rijen lager zoals in je voorbeeld?

3) Als je in dezelfde locatie rijen invoegd, kan het gebeuren dat er later van tijd terug iets in kolom B komt te staan waardoor je opnieuw 2 rijen gaat invoegen bij een volgende run of niet?

4) Waarom niet van in den beginne kolom A met tlst, oper en mapc voorzien?

 

[gast0667]

Bedoel je zoiets ?

Private Sub CommandButton1_Click()

'Voegt een kolom toe.
Columns("A:A").Select
Selection.Insert Shift:=xlToRight

'Onderstaande zoekt naar de laatste cel in het bereik A1:A100.
'Ik neem aan dat de laatste cel LEEG is.
With Worksheets(1).Range("B1:B100")
Set A = .Find(vLegeCel, LookIn:=xlValues)
    If Not A Is Nothing Then
        A = A.Row
    End If
End With

'Voegt onder elke cel t/m de laatste cel 2 lege rijen toe.
'Neem aan dat je ALTIJD een rij wil invoegen t/m de laatste cel.
vNummer = 2
Do While vNummer < A
        vInvoeg = vNummer + 1
        Rows(vInvoeg).Select
        Selection.Insert Shift:=xlDown
        Selection.Insert Shift:=xlDown
        Range("A" + CStr(vNummer)).Value = "tlst"
        Range("A" + CStr(vNummer + 1)).Value = "oper"
        Range("A" + CStr(vNummer + 2)).Value = "mapc"
        vNummer = vNummer + 3
        A = A + 2
Loop

 

[Jansap]

lege regsl invoegen

Hartelijk dank.

het werkt perfect op deze manier.