Search for value and copy rows below each other

[Geodav]

I have multiple sheets where I go through a loop. It looks for specific keywords. If found then take value where that keyword was found and insert it in "Mastersheet". I tried to change it so when the value was found the whole row of that value gets copied in "Mastersheet" but I cant get it to work. Each row should be copied below each other. Maybe my code can be modified.

Sub count()

totalsheets = Worksheets.count

mykeyword = Worksheets("Mastersheet").Cells(2, 19).Value
mykeyword2 = Worksheets("Mastersheet").Cells(3, 19).Value


For i = 1 To totalsheets

If Worksheets(i).Name <> "Mastersheet" Then
    lastRow = Worksheets(i).Cells(Rows.count, 1).End(xlUp).Row
    lastCol = Worksheets(i).Cells(Columns.count, 1).End(xlUp.Column
    For j = 8 To lastRow
    
    If Worksheets(i).Cells(j, 1).Value = mykeyword Then
    
    Worksheets("Mastersheet").Activate
    
    lastRow = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Row
    lastCol = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Column
    
    Worksheets("Mastersheet").Cells(lastRow + 1, 1).Value = Worksheets(i).Cells(j, 1).Value
    ElseIf Worksheets(i).Cells(j, 1).Value = mykeyword2 Then
    Worksheets("Mastersheet").Activate
    
    lastRow = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Row
    Worksheets("Mastersheet").Cells(lastRow + 1, 1).Value = Worksheets(i).Cells(j, 1).Value


    End If


 Next
 
 End If
 Next


End Sub

 

[kvsrinivasamurthy]

What is the problem with the code.

 

[RobP]

Hi, try this:

Sub count()

totalsheets = Worksheets.count

mykeyword = Worksheets("Mastersheet").Cells(2, 19).Value
mykeyword2 = Worksheets("Mastersheet").Cells(3, 19).Value


For i = 1 To totalsheets

If Worksheets(i).Name <> "Mastersheet" Then
    lastRow = Worksheets(i).Cells(Rows.count, 1).End(xlUp).Row
    lastCol = Worksheets(i).Cells(Columns.count, 1).End(xlUp).Column
    For j = 8 To lastRow
    
    If Worksheets(i).Cells(j, 1).Value = mykeyword Then
    
    Worksheets("Mastersheet").Activate
    
    lastRow = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Row
    lastCol = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Column
    
    Worksheets(i).Cells(j, 1).EntireRow.Copy Worksheets("Mastersheet").Cells(lastRow + 1, 1)
    ElseIf Worksheets(i).Cells(j, 1).Value = mykeyword2 Then
    Worksheets("Mastersheet").Activate
    
    lastRow = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Row
    Worksheets(i).Cells(j, 1).EntireRow.Copy Worksheets("Mastersheet").Cells(lastRow + 1, 1)


    End If


 Next
 
 End If
 Next


End Sub

 

[Geodav]

I have got a solution now for above problem. I was not sure how to copy and paste whole row where the value matches.
But I have got another question:

I also have in each Sheet 2 Values. In "E2" and in "A6". How would i go about this if i wanted to copy these values in a seperat column where the value was found?
So if value was found copy "E2" in the next available column and copy "A6" in the next available column. So basically "E2" and "A6" get always copied where the Crit1,Crit2,Crit3 matches.

Sub J3v16()
Dim Crit1 As String, Crit2 As String, ws As Worksheet
With Sheets("MasterSheet"): Crit1 = .Range("S2").Value: Crit2 = .Range("S3").Value: End With
For Each ws In Sheets
    If ws.Name <> "Mastersheet" Then
        With ws
            With .Range("A8:O" & .Cells(.Rows.Count, 1).End(xlUp).Row)
                .AutoFilter 1, Array(Crit1, Crit2), xlFilterValues
                .Offset(1).SpecialCells(12).Copy Sheets("MasterSheet").Range("A" & Rows.Count).End(xlUp)(2)
                .AutoFilter
            End With
        End With
    End If
Next ws
End Sub

 

[RobP]

Then I would go back to your original code you posted and use this:

Sub count()

totalsheets = Worksheets.count

mykeyword = Worksheets("Mastersheet").Cells(2, 19).Value
mykeyword2 = Worksheets("Mastersheet").Cells(3, 19).Value


For i = 1 To totalsheets

If Worksheets(i).Name <> "Mastersheet" Then
    lastRow = Worksheets(i).Cells(Rows.count, 1).End(xlUp).Row
    lastCol = Worksheets(i).Cells(Columns.count, 1).End(xlUp).Column
    For j = 8 To lastRow
    
    If Worksheets(i).Cells(j, 1).Value = mykeyword Then
    
    Worksheets("Mastersheet").Activate
    
    lastRow = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Row
    lastCol = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Column
    
    Worksheets(i).Cells(j, 1).EntireRow.Copy Worksheets("Mastersheet").Cells(lastRow + 1, 1)
    Worksheets("Mastersheet").Cells(lastRow + 1, 2).Value = Worksheets(i).Range("E2").Value
    Worksheets("Mastersheet").Cells(lastRow + 1, 3).Value = Worksheets(i).Range("A6").Value
    
    ElseIf Worksheets(i).Cells(j, 1).Value = mykeyword2 Then
    Worksheets("Mastersheet").Activate
    
    lastRow = Worksheets("Mastersheet").Cells(Rows.count, 1).End(xlUp).Row
    Worksheets(i).Cells(j, 1).EntireRow.Copy Worksheets("Mastersheet").Cells(lastRow + 1, 1)
     Worksheets("Mastersheet").Cells(lastRow + 1, 2).Value = Worksheets(i).Range("E2").Value
    Worksheets("Mastersheet").Cells(lastRow + 1, 3).Value = Worksheets(i).Range("A6").Value


    End If


 Next
 
 End If
 Next


End Sub

 

[Alex Blakenburg]

I also have in each Sheet 2 Values. In "E2" and in "A6". How would i go about this if i wanted to copy these values in a seperat column where the value was found?
So if value was found copy "E2" in the next available column and copy "A6" in the next available column. So basically "E2" and "A6" get always copied where the Crit1,Crit2,Crit3 matches.

Are you copying it to the Master or the original sheet ?
And you have hard coded the columns A:O so is the next available column P ?
if not what is the heading row to determine the last used column ?

 

[Alex Blakenburg]

If you want the additional info on Master and on LastCol + 1 and + 2, then try this
(It assumes the Master header row is on row 5, change that to whatever is the heading row)

Sub J3v16_Mod()
Dim Crit1 As String, Crit2 As String, ws As Worksheet

Dim wsMstr As Worksheet
Dim lastRowMstr As Long, nextRowMstr As Long, lastColMstr As Long

Set wsMstr = Worksheets("MasterSheet")
With wsMstr
    lastRowMstr = .Cells(Rows.count, "A").End(xlUp).Row
    lastColMstr = Cells(5, Columns.count).End(xlToLeft).Column   '<---- If row 5 is not the heading row change it here
    Crit1 = .Range("S2").Value
    Crit2 = .Range("S3").Value
End With

For Each ws In Sheets
    If ws.Name <> wsMstr.Name Then
        With ws
            With .Range("A8:O" & .Cells(.Rows.count, 1).End(xlUp).Row)
                .AutoFilter 1, Array(Crit1, Crit2), xlFilterValues
                nextRowMstr = lastRowMstr + 1
                .Offset(1).SpecialCells(12).Copy wsMstr.Range("A" & nextRowMstr)
                .AutoFilter
            End With
        End With
        
        With wsMstr
            lastRowMstr = .Cells(Rows.count, "A").End(xlUp).Row
            .Range(.Cells(nextRowMstr, lastColMstr + 1), .Cells(lastRowMstr, lastColMstr + 1)) = ws.Range("E2")
            .Range(.Cells(nextRowMstr, lastColMstr + 2), .Cells(lastRowMstr, lastColMstr + 2)) = ws.Range("A6")
        End With
    End If
Next ws
End Sub