Dim Rng as Range
Dim firstAddress as String

    With ActiveSheet
        Set Rng = .Cells.Find("КодЗаказа", , xlFormulas, xlWhole)
        firstAddress = Rng.Address 'запоминаем адрес первой найденной ячейки с "КодЗаказа"
        Do
            '
            ' тут ваше копирование куда хотите
            '
            Set Rng = .Cells.FindNext(Rng) 'продолжаем поиск второй ячейки с "КодЗаказа"
        Loop Until firstAddress = Rng.Address 'заканчиваем поиск, если дошли до первой найденной ячейки
    End With

With ActiveSheet

With Worksheets("название листа, где находятся эти КодЗаказа")

Sub tt()
'Пример кода в хелпе почему не смотрели?
    Dim c As Range, x&: x = 1

    With Worksheets(1).UsedRange
        Set c = .Find("КодЗаказа", after:=.Cells(.Cells.Count), LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.CurrentRegion.Copy Sheets(2).Cells(x, 1): x = x + c.CurrentRegion.Rows.Count
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End Sub