Copy row contents that are true from specific columns from different worksheets into a particular worksheet

Question

I need to copy the row contents from 3 specific columns from different worksheets on my workbook, to a particular range in a particular worksheet. e.g in Sheet1 I have a range from B1 to E40 I want to copy the contents from Columns B to D that display “TRUE” in column E and then paste it to Worksheet named “Analysis”.

I want the macro to go in Sheet 2, Sheet 3 and Sheet 4 and do the same (look for TRUE in column E and copy the rows B to D that meet that criteria) and paste the values one below the other in worksheet “Analysis”.

I’m pretty new to VBA and I have found a code that I think will be helpful to start with but I need help. Could you please give me an idea? I enclose the code that I found so that you can give me your comments it might not be the one needed but at list it might be a base. Many thanks.

Sub MyCode()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 3
LSearchRow = 3

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column BA = "Soccer", copy entire row to Sheet2
If Range("BA" & CStr(LSearchRow)).Value = "Soccer" Then

    'Select row in Sheet1 to copy
    Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
    Selection.Copy

    'Paste row into Sheet2 in next row
    Sheets("Sheet2").Select
    Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
    ActiveSheet.Paste

    'Move counter to next row
    LCopyToRow = LCopyToRow + 1

    'Go back to Sheet1 to continue searching
    Sheets("Sheet1").Select

    End If

    LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

Moritz Schmitz v. Hülst Moritz Schmitz v. Hülst · Accepted Answer · 2015-06-22T09:58:36

This should work for Sheet1. However you need to clarify where exactly you want to copy the values to on the "Analysis"-sheet.

Dim i As Long, j As Long, lR As Long, lastRow As Long, k As Long
Dim ws As Worksheet

lastRow = 1

For k = 1 To ThisWorkbook.Worksheets.Count
    If Sheets(k).Name <> "Analysis" Then
        Set ws = Sheets(k)
        lR = ws.Cells(ws.Rows.Count, 5).End(xlUp).Row

        For i = 1 To lR
            If ws.Cells(i, 5).Value = True Then
                lastRow = lastRow + 1
                For j = 2 To 4 '2 represents Columns(2) = B and 4 represents Columns(4) = D
                    If ws.Cells(i, j).Value <> "" Then
                        ThisWorkbook.Worksheets("Analysis").Cells(lastRow, j - 1).Value = ws.Cells(i, j)
                    End If
                Next j
            End If
        Next i
    End If
Next k

Copy row contents that are true from specific columns from different worksheets into a particular worksheet

1 Answers