PDA

View Full Version : Select and copy every second row



fraser5002
01-12-2009, 03:40 AM
Hi can anyone explain how i would select every second row in a worksheet and copy them to a new worksheet. I do not want to copy one at a time i would rather be able to select them all and then copy them in one block

Thanks

Bob Phillips
01-12-2009, 04:39 AM
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim rng As Range

With ActiveSheet

.Columns(2).Insert
LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
.Range("B2").Resize(LastRow - 1).Formula = "=MOD(ROW(),2)"
.Columns(2).AutoFilter field:=1, Criteria1:=1
Set rng = .Range("A1").Resize(LastRow).SpecialCells(xlCellTypeVisible)
rng.EntireRow.Copy Worksheets("Sheet2").Range("A1")
Worksheets("Sheet2").Columns(2).Delete
.Columns(2).Delete
End With

End Sub