Uddrag hver 3. og derefter hver anden

Det skal skrives i VBA.

Udvikler > Visual Basic..

Højreklik på "VBAProject" vælg Insert > Module..

Skriv følgende kode:




Sub OneCell()

For i = 1 To 1500
    If i Mod 3 = 0 Then
        Range("A" & i).Select
        Selection.Cut
        Range("C" & i).Select
        ActiveSheet.Paste
        Range("B" & i).Select
        Selection.Cut
        Range("D" & i).Select
        ActiveSheet.Paste
   
        Application.CutCopyMode = False
    End If
Next
   
End Sub




Gem som "Excel-projktmalle med aktive makrier (*.xlsm)

Kør filen fra:

Udvikler > Makroer..

Eller opret en hotkey.

Nå vi har fundet ud af det.

Tak lægger du ikke lige et svar - så du kan få nogle points ?

Ehm jamen ok da...

Hov!

Mange tak. Dét var generøst!

Jeg kan se, jeg manglede en hel del. Nu lavede jeg den lige færdigt for en god ordens skyld.

Det, der dog ultimativt sker, når du først lader hver tredje overleve og derefter hver anden af disse, er jo, at du i første omgang lige så godt kunne have ladet hver sjette overleve.

Jeg mener:

Navn1
Navn2
Navn3
Navn4
Navn5
Navn6
Navn7
Navn8
Navn9
Navn10
Navn11
Navn12
Navn13

Bliver til:

Navn3
Navn6
Navn9
Navn12

Som efterfølgende bliver til:

Navn6
Navn12

Altså det samme, som hvis du i første omgang havde valgt hver sjette.

Med mindre jeg misforstår, hvad du ønsker? :-)


Sub OneCell()

For i = 1 To 100
    If i Mod 3 = 0 Then
        Range("A" & i).Select
        Selection.Cut
        Range("C" & i / 3).Select
        ActiveSheet.Paste
        Range("B" & i).Select
        Selection.Cut
        Range("D" & i / 3).Select
        ActiveSheet.Paste
   
        Application.CutCopyMode = False
    End If
Next

Columns(1).EntireColumn.Delete
Columns(1).EntireColumn.Delete

For i = 1 To 100
    If i Mod 2 = 0 Then
        Range("A" & i).Select
        Selection.Cut
        Range("C" & i / 2).Select
        ActiveSheet.Paste
        Range("B" & i).Select
        Selection.Cut
        Range("D" & i / 2).Select
        ActiveSheet.Paste
   
        Application.CutCopyMode = False
    End If
Next

Columns(1).EntireColumn.Delete
Columns(1).EntireColumn.Delete

End Sub