Zdravim,
napr. makrem nize:
Sub test()
'kazda 50. bunka
Const iSTEP As Integer = 50
Dim ws As Worksheet
Dim rng As Range, x As Long, LR As Long
'data na listu1
Set ws = Sheets(1)
'oblast dat je A2:Axxx
Set rng = ws.Range("A2:A" & ws.Range("A" & Rows.Count).End(xlUp).Row)
'posledni bunka v oblasti
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
'pozadovana hodnota je kopirovana do nasledujiciho sloupce
For x = 1 To LR Step iSTEP
rng.Item(x).Offset(0, 1) = rng.Item(x)
Next x
'odstraneni prazdnych bunek
rng.Offset(0, 1).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
End Sub
sydcitovat
napr. makrem nize:
Sub test()
'kazda 50. bunka
Const iSTEP As Integer = 50
Dim ws As Worksheet
Dim rng As Range, x As Long, LR As Long
'data na listu1
Set ws = Sheets(1)
'oblast dat je A2:Axxx
Set rng = ws.Range("A2:A" & ws.Range("A" & Rows.Count).End(xlUp).Row)
'posledni bunka v oblasti
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
'pozadovana hodnota je kopirovana do nasledujiciho sloupce
For x = 1 To LR Step iSTEP
rng.Item(x).Offset(0, 1) = rng.Item(x)
Next x
'odstraneni prazdnych bunek
rng.Offset(0, 1).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
End Sub
sydcitovat
32446_excel_filtr.png
RSS nejnovější články