copy paste

[RDIE]

Hallo
Ik heb een excel sheet met 6 kolommen gevuld, A t/m F.
Het aantal gevulde rijen varieert steeds.
Ik wil een code die overal een lege rij tussen zet, dus 1e rij gevuld, 2e rij leeg, 3e rij gevuld etc.
Dit is me inmiddels gelukt met de volgende code:

Application.ScreenUpdating = False
    With Sheets(1)
        For c = .UsedRange.Rows.Count To 2 Step -1
            Rows(c).Insert
            Next
    End With
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp

Nu wil ik echter ook nog dat de code verder gaat en steeds van de gevulde regel het stukje uit cel D, E en F knipt en daarna plakt in de lege regel daaronder
en wel in de desbetreffende cellen A, B en C
Wie kan me hiermee helpen?

 

[Leotaxi]

één van de mogelijkheden

Application.ScreenUpdating = False
    lr = Sheets("blad1").Range("A" & Rows.Count).End(xlUp).Row * 2
    x = 1
    With Sheets(1)
        For c = 2 To lr Step 2
            Rows(c).Insert
            Range("D" & x, "F" & x).Cut Destination:=Cells(x + 1, 1)
            x = x + 2
            Next
    End With
Application.ScreenUpdating = True

mvg
Leo

 

[RDIE]

Beste Leo,

werkt perfect, precies wat ik bedoelde!
Mijn dank voor de hulp.
gr
RDIE

 

[VenA]

Ik weet niet of het om veel rijen gaat. En wat er in de cellen staat. Maar als het alleen om waarden gaat kan je deze eens testen. Gaat een beetje sneller.

Option Base 1
Sub VenA()
With Sheets(1).Cells(1)
    ar1 = .CurrentRegion
    t = 1
    ReDim ar2(UBound(ar1) * 2, 3)
    For j = 1 To UBound(ar1)
        For jj = 1 To 3
            ar2(t, jj) = ar1(j, jj)
            ar2(t + 1, jj) = ar1(j, jj + 3)
        Next jj
        t = t + 2
    Next j
    .CurrentRegion.ClearContents
    .Resize(UBound(ar2), 3) = ar2
End With
End Sub

 

[Leotaxi]

@ Ven A

heb hem ook even getest, mare mijn zes kolommen worden er geen 3 maar 2
en sommige gegevens zijn weg, andere staan dubbel.

zou natuurlijk wel sneller zijn met minder bewerkingen op werkblad.


mvg
Leo

 

[VenA]

Dan ben je deze vergeten

Option Base 1

:d

 

[Leotaxi]

nu wel 3 kolommen, maar toch nog gegevens weg en andere dubbel


mvg
Leo

 

[VenA]

Je hebt gelijk. Het gaat hier fout

ar2(t + 1, jj) = ar1(j, jj * 2)

moet zijjn

ar2(t + 1, jj) = ar1(j, jj + 3)

Het is nog vroeg zullen we maar zeggen

 

[Leotaxi]

helemaal goed nu :thumb:

en vroeg of laat
voor mij hetzelfde als halfvol of halfleeg glaasje bier, ze mogen het beide geven


mvg
Leo