Find string in column and paste corresponding row into other sheet

Would this work for you (try it on a copy of your workbook)

Sub With_AutoFilter()
    Dim lr As Long
    Application.ScreenUpdating = False
    lr = Sheets("SourceData").Cells(Rows.Count, 1).End(xlUp).Row

        With Sheets("SourceData")
            .AutoFilterMode = False
            .Range("A1:A" & lr).AutoFilter field:=1, Criteria1:="11-11-222"
            .Range("A2:A" & lr).SpecialCells(12).EntireRow.Copy Sheets("Parts").Cells(Rows.Count, "A").End(xlUp)(2)
            .AutoFilterMode = False
        End With

    Application.ScreenUpdating = True
End Sub

Jolivanes has nice code working perfectly , try it...ignore mine has some errors.

try this, little change of your code...

Option Explicit

Sub CopyRowToAnotherSheet()
    Dim strFind As String
    Dim NextRow As Long
    Dim rngFound As Range
    Dim wbook As Workbook
    
    Dim wsSource As Worksheet
    Dim wsResult As Worksheet
    

Application.ScreenUpdating = False

'Main Code
    Set wbook = ThisWorkbook
    Set wsSource = wbook.Sheets(1)
    Set wsResult = wbook.Sheets(2)
    
    For Each wsSource In Worksheets
    
        strFind = "11-11-222"
        Set rngFound = wsSource.Cells.Find(What:=strFind, LookAt:=xlPart)
        If Not rngFound Is Nothing Then
            NextRow = wsResult.Range("A" & Rows.Count).End(xlUp).Row + 1
            rngFound.EntireRow.Copy wsResult.Range("A" & NextRow)
        End If
  Next
  

End Sub

Untested

Sub CopyRowToAnotherSheet()
Application.ScreenUpdating = False
Dim rngFound As Range, strFind As String, sAddr As String, wsSource As Worksheet, wsResult As Worksheet, NextRow As Long
    Set wsSource = Sheets("SourceData")
    Set wsResult = Sheets("Parts")
    wsResult.Rows("2:" & Rows.Count).ClearContents
    strFind = "11-11-222"

        With wsSource.Range("A:A")
            Set rngFound = .Find(strFind, .Cells(.Cells.Count), xlValues, xlWhole)
            If Not rngFound Is Nothing Then
                sAddr = rngFound.Address
                Do
                 NextRow = wsResult.Range("A" & Rows.Count).End(xlUp).Row + 1
                 rngFound.EntireRow.Copy wsResult.Range("A" & NextRow)
                    Set rngFound = .FindNext(rngFound)
                Loop While rngFound.Address <> sAddr
                sAddr = ""
            End If
        End With
   Application.ScreenUpdating = True
End Sub

I don't know. Will this do?

Sub With_AutoFilter_A()
    Dim lr As Long
    Application.ScreenUpdating = False
    lr = Sheets("SourceData").Cells(Rows.Count, 1).End(xlUp).Row

    With Sheets("SourceData")
        .AutoFilterMode = False
        .Range("A1:A" & lr).AutoFilter field:=1, Criteria1:="11-11-222"
        With Range("A:A, B:B, D:D").SpecialCells(12)
            .SpecialCells(2).Copy Sheets("Parts").Cells(Rows.Count, "A").End(xlUp)(2)
        End With
        .AutoFilterMode = False
    End With

    Application.ScreenUpdating = True
End Sub

Maybe a slight change in AB33's code will be better.

Or maybe like this.

Sub Use_Union()
    Dim lr As Long, c As Range
    Application.ScreenUpdating = False
    lr = Sheets("SourceData").Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("SourceData")
        .AutoFilterMode = False
        .Range("A1:A" & lr).AutoFilter field:=1, Criteria1:="11-11-222"
        For Each c In .Range("A2:A" & lr).SpecialCells(12)
            .Application.Union(c, c.Offset(, 1), c.Offset(, 3)).Copy Sheets("Parts").Cells(Rows.Count, "A").End(xlUp)(2)
        Next c
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub