Excel VBA Search, Copy, & Paste

Question

I am looking for some help modifying existing code in a worksheet that I had created a while back to copy and paste a range from a row rather than the entire row itself.

The original code, which has worked perfect in the original intended function, it would search column A in the Data worksheet for a specified match. it would then copy that row into a specified worksheet and paste each match as a new row.

What I have been trying to modify the code to do now is perform that same search of column A for either " New, Existing Being Removed, Existing To Remain". When finding one of the 3 options it would then copy the data from columns b:g of that matching row and paste it into the rent worksheet starting at a specified cell. For instance rows marked as Existing to remain would need to star being pasted at cell B3, Existing being removed cell m3, and New cell x3. In total there would not be more than 20 rows from the data sheet that would need to be copied and pasted appropriately.

The code below is the current working code that will search, copy, and paste the entire matching row. Not being extremely proficient with VBA code I didn't want to post the muddled mess that I had made of the original code.

Edit With Photos*

@Toddleson I made the changes you suggested but ended up getting an error with the copyfrom.copy line. It is probably much easier to see what I am trying to accomplish visually. In the Data sheet image link below you will see that row A is where the search occurs. For each match it will copy the values from columns B:G of that row and then paste that into the rent sheet.

If you take a look at the rent image you will see that it is broken into the 3 cooresponding sections. From the match that was found in the cooresponing deisgnation from column A in the data sheet it will then paste the information from columns B:G in the Data to the B:G columns in the Rent sheet.

Data Sheet

Rent

Private Sub CommandButton4_Click()
 Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim copyFrom As Range
    Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
    Dim strSearch As String

    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("Data")


    strSearch = "New"

    With ws1
        .AutoFilterMode = False
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        With .Range("A1:A" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            Set copyFrom = .Resize(lRow - 1, 7)
        End With
        .AutoFilterMode = False
    End With
        
        Set ws2 = wb1.Worksheets("Rent")
    With ws2
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=Range("p3"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 1
        End If

        copyFrom.Copy ws2.Cells(3, 16).Resize(copyFrom.Rows.Count, copyFrom.Columns.Count)
        
    End With

    
    strSearch = "Existing Being Removed"

    With ws1
        .AutoFilterMode = False
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        With .Range("A1:A" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With
        .AutoFilterMode = False
    End With
        
        Set ws2 = wb1.Worksheets("Rent")
    With ws2
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=Range("p19"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 1
        End If

         copyFrom.Copy ws2.Cells(3, 16).Resize(copyFrom.Rows.Count, copyFrom.Columns.Count)

    End With
    
    
        strSearch = "Existing To Remain"

    With ws1
        .AutoFilterMode = False
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        With .Range("A1:A" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
        End With
        .AutoFilterMode = False
    End With
        
        Set ws2 = wb1.Worksheets("Existing To Remain")
    With ws2
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lRow = .Cells.Find(What:="*", _
                          After:=.Range("p35"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 1
        End If

         copyFrom.Copy ws2.Cells(3, 16).Resize(copyFrom.Rows.Count, copyFrom.Columns.Count)

    End With
    
 
End Sub