Macro voor cellen te verplaatsen

[pallieter75]

Hallo,

Weet er iemand hoe je een macro kunt schrijven om de inhoud van cel C2 te verplaatsen naar D1, cel C4 naar D3, cel C6 naar D5, cel C8 naar D7, enzovoort.

Mvg,
Jan

 

[MagicPc1]

Wat bedoel je met enzovoort? Hoe ver gaat dat door?
En waarom zet je het niet gelijk op de goede plaats?

 

[pallieter75]

MagicPc1,

De tekst is van een website gekopieerd naar een excel bestand. Zoals je kan zien in bijgevoegde excel bijlage staat het uur altijd onder de datum. Ik zou het uur graag naast de datum hebben.
Je kan ook elke keer het uur manueel verplaatsen maar dan wordt het wel een tijdrovende bezigheid. Vandaar mijn vraag over die macro.

Mvg,
Jan

 

[VenA]

Je kan dit ook eenvoudig met een formule en een filter oplossen.
=ALS(C1>1;C2) doortrekken naar beneden. Fileren op onwaar en de regels verwijderen.

Met code krijg je zoiets.

Sub VenA()
lr = Cells(Rows.Count, 1).End(xlUp).Row
With Range("D1:D" & lr)
    .Value = Range("C2:C" & lr + 1).Value
    .NumberFormat = "hh:mm"
End With
Range("A1:A" & lr).SpecialCells(4).Rows.EntireRow.Delete
End Sub

Waar je eventueel een lusje omheen kan zetten die alle tabjes bewerkt.

 

[MarcelBeug]

Nog een alternatief: C2 selecteren, Ctrl+Shift+Pijlte naar beneden, dat blok slepen naar D1 met de Ctrl-toets ingedrukt, filteren op lege regels in kolom A of B en deze verwijderen.

 

[pallieter75]

VenA,

Bedankt voor de code, ze werkt perfect.:thumb:

Mvg,
Jan

 

[pat007]

rijen verdwijnen niet

IK heb bovenstaande code aangepast naar mijn behoefte, maar de even rijen verdwijnen niet.
Kan er iemand mij daar bij helpen om een stukje code bij te schrijven zodat ik alleen de onpaar rijen blijven.

Dank bij voorbaat,

Pat007

 

[VenA]

Je kan beter een eigen draadje starten dan kijken er meer helpers naar.

Je hebt de code in een bladmodule staan wat niet de juiste plek is.
Jouw bestandje bevat geen lege cellen Specialcells(4) daardoor doet de code niet wat je wil.

Plaats deze in een gewone module en test het eens. Als het niet werkt dan even een eigen draadje aanmaken.

Sub VenA()
With Sheets(1)
    ar = .Cells(1).CurrentRegion
    ReDim ar1(1 To UBound(ar) / 2, 1 To 2)
    For j = 1 To UBound(ar)
        ar1(((j + 1) / 2), 1) = ar(j, 1)
        ar1(((j + 1) / 2), 2) = ar(j + 1, 1)
        j = j + 1
   Next j
   .Cells.ClearContents
   .[A1].Resize(UBound(ar1), 2) = ar1
End With
End Sub

 

[pat007]

VenA,

Ik heb uw code aan de vorige geplakt, en dat gaat zeer goed, alleen moet ik mijn lettertypes aanpassen maar dat is zo gefikst.

Dank U

Pat007