Sub PoiskPerenos()
Dim iLR As Long
Dim FoundCell As Range
Dim FAdr As String
    With Worksheets("Лист1")
      .Cells.Clear
        Set FoundCell = Columns("AG").Find("требуется", , xlValues, xlWhole)
       If Not FoundCell Is Nothing Then
        FAdr = FoundCell.Address
           Range("A2:E2").Copy .Range("A1")     'копируем заголовки
           Range("AC2:AE2").Copy .Range("F1")
         Do
           iLR = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
           Range("A" & FoundCell.Row & ":E" & FoundCell.Row).Copy .Cells(iLR, "A")
           Range("AC" & FoundCell.Row & ":AE" & FoundCell.Row).Copy .Cells(iLR, "F")
          Set FoundCell = Columns("AG").FindNext(FoundCell)
         Loop While FoundCell.Address <> FAdr
       End If
    End With
End Sub