CODEWITHSUNDEEP
vbaexcel
mabanger
mabanger

Reputation: 147

How to copy every row except every nth

In excel I would like to copy the date from one sheet to another one using macro in a way that it will copy everything until row 9, then it will skip row 10 and copy row 11 and 12, and then skip one again.

So it should not copy row 10,13,16,19, etc..

I have the following code 

Dim i As Integer
i = 9
J = 1
K = 9

Do While i < 5000
    If J = 3 Then
        J = 0
        Sheets("sheet1").Select
        Rows(i).Select
        Selection.Copy
        Sheets("sheet2").Select
        Cells(K, 1).Select
        ActiveSheet.Paste
        K = K + 1
    End If

    J = J + 1
    i = i + 1
Loop

This code is copying everything till the 8th row and then every 3rd, can somebody help me how to modify that code?

Upvotes: 1

Views: 358

Answers (4)

Ricardo A
Ricardo A

Reputation: 1815

This code will only paste values. Let me know if any questions or if you really, really need the formatting I can tweak it.

Sub DoCopy()
    'This code is pretty much specifit to your request/question, it will copy 1-9, skip 10, 13, 16....
    'i for the loop, x for the row that will not be added, y to paste on the second sheet
    Dim i, x, y As Long, divn As Integer
    For i = 1 To 5000
        If i < 10 Then
            y = y + 1
            Sheets("Sheet1").Rows(i).Copy
            Sheets("Sheet2").Range("A" & y).PasteSpecial ''Paste values only
        ElseIf i >= 10 Then
            x = i - 10
            If x Mod 3 <> 0 Then
                y = y + 1
                Sheets("Sheet1").Rows(i).Copy
                Sheets("Sheet2").Range("A" & y).PasteSpecial ''Paste values only
            Else
                'Do nothing
            End If
        End If
    Next i
End Sub

Upvotes: 0

Shai Rado
Shai Rado

Reputation: 33692

Fastest way will be to Copy >> Paste the entire rows once, according to your criteria.

You can achieve it by merging all rows that needs to be copies to a Range object, in my code it's CopyRng, and you do that by using Application.Union.

Code

Option Explicit

Sub CopyCertailRows()

Dim i As Long
Dim CopyRng As Range

Application.ScreenUpdating = False

With Sheets("sheet1")
    ' first add the first 8 rows to the copied range
    Set CopyRng = .Rows("1:8")

    For i = 9 To 5000
        If (i / 3) - Int(i / 3) <> 0 Then ' don't add to copied range the rows that divide by 3 without a remainder
            Set CopyRng = Application.Union(CopyRng, .Rows(i))
        End If
    Next i
End With

' copy >> paste in 1- line
CopyRng.Copy Destination:=Sheets("sheet2").Range("A9")

Application.ScreenUpdating = True

End Sub

Upvotes: 1

CLR
CLR

Reputation: 12289

You could simplify this massively by using If i < 10 Or (i - 1) Mod 3 <> 0 Then... which will select the rows you're interested in. Like so:

Dim i As Integer, j As Integer
j = 0

Dim sourceSht As Worksheet
Dim destSht As Worksheet
Set sourceSht = Sheets("Sheet1")
Set destSht = Sheets("Sheet2")

For i = 1 To 5000
    If i < 10 Or (i - 1) Mod 3 <> 0 Then
        j = j + 1
        sourceSht.Rows(i).Copy destSht.Rows(j)
    End If
Next

Personally, I'd turn screen updating and calculations off before running this and enable them again after to reduce the time needed to perform the loop.

Also, as Michał suggests, unless your dataset happens to be exactly 5,000 rows, you might want to 'find' the last row of data before starting to further reduce the time needed.

Upvotes: 0

Michał Turczyn
Michał Turczyn

Reputation: 37525

All necessary comments in code:

'declare all variables, be consistent with lower/uppercases, use Long instead of Integeer (its stored as long anyway)
'use meaningful variable names
Dim i As Long, copyUntil As Long, currentRow As Long
copyUntil = 9
currentRow = 1
'copy all rows until we reach 9th row
For i = 1 To copyUntil
    Sheets("sheet1").Rows(i).Copy
    Sheets("sheet2").Rows(currentRow).Paste
    currentRow = currentRow + 1
Next
'now we will takes steps by 3, on every loop we will copy i-th row and next one, third will be omitted
'we also use currentRow variable to avoid empty rows in sheet2
'also, 5000 seems wrong, I'd recommend to determine last row, until which we will loop
'last row is often determined like Cells(Rows.Count, 1).End(xlUp).Row
For i = copyUntil + 2 To 5000 Step 3
    Sheets("sheet1").Rows(i).Copy
    Sheets("sheet2").Rows(currentRow).Paste
    currentRow = currentRow + 1
    Sheets("sheet1").Rows(i + 1).Copy
    Sheets("sheet2").Rows(currentRow).Paste
    currentRow = currentRow + 1
Next

Upvotes: 0

Related Questions