Sub CopyRows()
Dim lRow As Long           'Counter
Dim lCol As Long           'Counter
Dim lCount As Long         'Counter
Dim rInputTable As Range   'The range being searched
Dim rTarget As Range       'The output table
Dim arInput()              'Array with input table
Dim arOutput()             'Array for output table
Dim vPattern As Variant    'Search criteria/pattern

On Error GoTo ErrorHandle

'Query the user for an exact identifier or a pattern
vPattern = InputBox("Идентификатор для копируемых строк" & vbNewLine _
& "Вы можете использовать подстановочные знаки для создания шаблонов:" & vbNewLine & vbNewLine _
& "?   Любой одиночный символ" & vbNewLine _
& "*   Ноль или больше символов" & vbNewLine _
& "#   Любая цифра (0-9)" & vbNewLine _
& "[charlist]   Любой символ в charlist" & vbNewLine _
& "[!charlist]  Любой символ не в charlist", "Копирование строк")

'If the user clicked cancel or didn't write anything we exit
If Len(vPattern) = 0 Then Exit Sub

'You can define the input table as you like.
'In this case we use A1's current region.
'The "current region" is a range bounded by
'any combination of blank rows and blank columns.
'So if there are no blank columns or rows in the
'table, it is a convenient way to define the range.
Set rInputTable = Range("A9").CurrentRegion
Dim wsh As Worksheet
 
For Each wsh In ThisWorkbook.Worksheets

'Copy the table to the array arInput.
'The array will automatically get the
'same dimensions as the table.
'The reason for using an array is speed.
arInput = rInputTable.Value

'The table has been copied to the array, arInput,
'so we don't need the range anymore and set it to
'nothing to save memory.
Set rInputTable = Nothing

'Redimensions the output array to the same dimensions
'(rows and columns)as the input table. This will nearly
'always be bigger than necessary, but unless you have
'limited space for the output table, it doesn't matter,
'because we fill it from the top, and the last records
'will be empty rows.
'1 To UBound(arInput) is the number of rows, and
'1 To UBound(arInput, 2) is the number of columns
ReDim arOutput(1 To UBound(arInput), 1 To UBound(arInput, 2))

'Loop through the input array and copy records that
'match the search pattern to the output array.
For lRow = 1 To UBound(arInput)
   'To compare we use the "Like" operator
   'instead of "=". This allows the use of
   'patterns/wildcards.
   'The code assumes that the identifier
   'is in the first column, but that can
   'easily be changed. If you do so, you
   'must be sure that the column exists,
   'or you will get an error!
   If arInput(lRow, 1) Like vPattern Then
      'If there is a match, we increment
      'the counter lCount and copy the
      'row to the output array.
      lCount = lCount + 1
      
      'All cell values to the right of the
      'first cell are copied. If you don't
      'want all cell values copied, you must
      'write a column number instead of
      'UBound(arInput, 2)
      For lCol = 1 To UBound(arInput, 2)
         arOutput(lCount, lCol) = arInput(lRow, lCol)
      Next
   End If
Next

'If lCount is zero, there was no match
If lCount = 0 Then
   MsgBox "No records matched your search criteria"
   GoTo BeforeExit
End If

'In this example we add a new workbook and copy the
'output array to range A1 etc.
'Of course you can define another destination, e.g.
'a specific workbook or just another sheet.
Workbooks.Add

'Dimension the target table to the same size as the
'output array.
Set rTarget = Range("A1").Resize(UBound(arOutput), UBound(arOutput, 2))

'Copy the array to the range in one swift operation.
rTarget.Value = arOutput

BeforeExit:
On Error Resume Next
Set rTarget = Nothing
Erase arInput
Erase arOutput

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure CopyRows"
Resume BeforeExit
Next wsh
End Sub