CODEWITHSUNDEEP
vbaexcelcopy-paste
user3150260
user3150260

Reputation: 99

Copy row plus next 3

I have the below code that works great. It parses through all my sheets and finds the row in column A that I want and pastes it to a specified worksheet. However, I need it to copy the specified row plus the next X number of rows. Can someone help me accomplish this?

Sub FindValues()
    Dim ws As Excel.Worksheet
    Dim LastRow As Long
    Dim i As Integer

    For Each ws In Application.ThisWorkbook.Worksheets
        LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
        i = 1

        Do While i <= LastRow
            If ws.Range("A" & i).Value = "OwnershipType Ownership Type" Then
                ws.Rows(i).Copy Sheets("Summary").Range("A2")
                i = i - 1
                LastRow = LastRow - 1
            End If
            i = i + 1
        Loop
    Next


End Sub

Upvotes: 0

Views: 500

Answers (2)

Paresh J
Paresh J

Reputation: 2419

I have done some minor modifications. Just added (i + number of rows to be copied). Check the below code: Used Integer copyrw in the code, you can set this integer to copy the number of rows.

Sub FindValues()
    Dim ws As Excel.Worksheet
    Dim LastRow As Long
    Dim i As Integer
    Dim copyrw as Integer

copyrw = 3
For Each ws In Application.ThisWorkbook.Worksheets
    LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    i = 1

    Do While i <= LastRow
        If ws.Range("A" & i).Value = "OwnershipType Ownership Type" Then
            ws.Rows(i & ":" & i + copyrw).Copy Sheets("Summary").Range("A2")
            i = i - 1
            LastRow = LastRow - 1
        End If
        i = i + 1
    Loop
Next


End Sub

Upvotes: 0

Gareth
Gareth

Reputation: 5243

You can amend the range of rows being copied on this line like so:

ws.Rows(i & ":" & i + 3).Copy Sheets("Summary").Range("A2")

If the match was found in row 1 for example, the code would render as ws.Rows(1:4).Copy

Upvotes: 1

Related Questions