Same condition, multiple columns check, then copy rows

[katy.brooke]

Hi all.
Really exceptionally new to VBA - think about 2 hours, so this is definitely above my skill level but you guys seem amazing, I have already used one of the macros found in another post to do something, so thanks for that. This one is a little more complicated.

I am trying to create a Macro that searches multiple columns of names from a different sheet to find a name that is in a specific cell, and if the name is found in any of those rows, to copy the rows across to the first sheet. So far I managed to check the first column of names, but the only way I've managed to do it is by copying everything across then deleting the ones that I don't need (See Macro below) which I got from a co-worker, but I need to check 8 rows, and that is just not going to work with the code that I already have. Although, if you see the what the code does, it might make more sense as to what I am trying to do. My current macro is:

Sub DeleteRows() 'could be useful to use a do while for deleting rows

    Dim i As Integer
    i = 5 'starting row
    j = 3
    Range("Data").Copy 'Copies data"
    Sheet4.Cells(i, 1).PasteSpecial Paste:=xlPasteValues 'Pastes data values (may need to paste formatting)
    
    Do While Not IsEmpty(Sheet4.Cells(i, 1).Value) '1 is the column value (change as needed)
           
         If Sheet4.Cells(i, 3).Value <> Range("A1") Then
            Sheet4.Rows(i).Delete
         Else
            i = i + 1
         End If
    Loop
   
    Sheet4.Cells(i, 1).Select 'return cursor to original position


End Sub

But this clearly won't work!

I have added an excel spreadsheet with some sample data(names obviously changed) in the structure I am looking for. If anything is unclear please let me know!

Summary: I want to be able to type different names in cell B5 in Sheet2 (Personal) and have the button run through columns D-K in Sheet1 (All) to find if that name appears, and if it does, copy the row across to Sheet2 (Personal) starting in row 8.

(I will then be using this data to create a Gantt chart for each individual if you were curious as to what was going on).

Any help is super appreciated! Thanks!

[mdmackillop]

Sub Test()
    Dim r As Range, tgt As Range, Rw As Range
    Dim Data As String
    Dim LR As Long


    Data = Sheets("Personal").Cells(5, 2)
    With Sheets("All")
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        Set r = Range(.Cells(5, 4), .Cells(LR, 11))
        For Each Rw In r.Rows
            If Not IsError(Application.Match(Data, Rw, 0)) Then
                Rw.EntireRow.Copy Sheets("Personal").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next Rw
    End With
End Sub

[katy.brooke]

Sub Test()
    Dim r As Range, tgt As Range, Rw As Range
    Dim Data As String
    Dim LR As Long


    Data = Sheets("Personal").Cells(5, 2)
    With Sheets("All")
        LR = .Cells(Rows.Count, 1).End(xlUp).Row
        Set r = Range(.Cells(5, 4), .Cells(LR, 11))
        For Each Rw In r.Rows
            If Not IsError(Application.Match(Data, Rw, 0)) Then
                Rw.EntireRow.Copy Sheets("Personal").Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next Rw
    End With
End Sub

Thankyouthankyouthankyou!That works great! P.S. Great profile pic, I have a Ridgeback as well. :-)