Copy rows from multiple sheets into one sheet

Question

Public Sub SubName()
Dim ws As Worksheet
Dim iCounter As Long
Dim wso As Worksheet
Dim rw As Long
Dim lastrow As Long

Set wso = Sheets("Master")

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "*" & "danger" & "*" Then
    ws.Select
    lastrow = ws.Cells(Rows.Count, 4).End(xlUp).Row
            For iCounter = 2 To lastrow
                If ws.Cells(iCounter, 8) < 0.15 And ws.Cells(iCounter, 8) > -0.1 Then

                    ws.Cells(iCounter, 8).EntireRow.Copy

                    rw = wso.Cells(wso.Rows.Count, "A").End(xlUp).Row + 1
                    wso.Cells(rw, 1).PasteSpecial Paste:=xlPasteAll

                End If
            Next iCounter

    End If
Next ws
End Sub

This is what the code does:

Look through all sheets, find sheets with text "danger"
With sheets named "danger*", go through column H and copy the entire row if criteria is met
Paste the entire row onto master sheet

I believe the code is working fine up to the point where I need it to paste onto the master sheet. The problem i'm getting is that it simply pastes over the same row on the master sheet, instead of going row+1.

The end result is there's only one row showing on the master sheet and it's the last row in the iteration that's to be pasted.

Any help is appreciated!

instead of going row+1. so you know what you need to do XD Edit: oh, rw is already +1 hmmm — findwindow
in the data that is being copied, is there data in column A? — Scott Craner
@ScottCraner, i'm a fool................ that fixed it. thanks so much! — Daruki

Shubham Shubham · Accepted Answer · 2016-05-19T15:08:49

Try this to copy rows from one worksheet to another worksheet(with each row on different row):

Dim i, lastRow as Integer

Dim wso, ws, copyFrom as Worksheet

Set wso = Sheets("Master")

For Each ws In ActiveWorkbook.Worksheets

If ws.Name Like "*" & "danger" & "*" Then

    copyFrom =  ws.Select

End if


lastRow = Sheets(copyFrom).Range("A" & Rows.Count).End(xlUp).Row
For i=1 to lastRow

If <--your criteria--> then

    ThisWorkbook.Sheets(copyFrom).Rows(i).EntireRow.Copy Destination:=ThisWorkbook.Sheets(wso).Rows(i)

End if

Next i
Next ws

Copy rows from multiple sheets into one sheet

1 Answers