Перенос отфильтрованных данных

[ambasad]

Помогите пожалуйста разобраться в таком вопросе: Имеется таблица из которой надо перенести все строки, удовлетворяющие определенному условию, на отдельный лист. Реальная таблица содержит от 10 до 100 тысяч строк, поэтому перебирать значения ячеек (даже в массиве а не с листа) будет достаточно долго. Посему я решил использовать автофильтр с последующим переносом отфильтрованных ячеек. Но тут возникла проблема - перенос данных с помощью копипаста работает, но юзать не хочется, т.к. скрипт будет работать в фоне на удаленном компе и неосторожные действия на рабочей машине приводят к изменению содержимого буфера и на удаленной машине. Посему хочется чтобы перенос был напрямую из диапазона в диапазон или же через промежуточный массив (ну или любым другим способом без копипаста и перебора). Собственно вопрос: возможно ли это сделать и как?

В файле пример. Макрос2 с копипастом работает, Макрос1 не работает, помогите плиз

[Дмитрий Щербаков(The_Prist)]

Могу предложить на массивах: сначала в массив заносим, затем перебираем и все строки, удовлетворяющие критерию записываем в другой массив. Затем этот массив одним махом выгружаем на лист. Должно быть быстро.
Если подходит - покажу на Вашем примере.

[staniiislav]

Могу предложить на массивах: сначала в массив заносим, затем перебираем и все строки, удовлетворяющие критерию записываем в другой массив. Затем этот массив одним махом выгружаем на лист. Должно быть быстро.
Если подходит - покажу на Вашем примере.

Если Вас не затруднит, сделайте, мне тоже интересно как это можно реализовать массивами (и если есть информация по построению массивов, дайте ссылочку пожалуйста)

[ambasad]

На массивах сам смогу... действительно ли это быстро будет.....

[ambasad]

The_Prist, спасибо за наводку  
В общем макрос боевую табличку в 50 тысяч строк обрабатывает мене чем за минуту.....
Думаю что даже при условии что надо будет перебирать десятки таких таблиц, время приемлемое.

Код Выделить Развернуть

Sub Макрос3()
   Dim arrData(), arrResult(), fRegion
   Dim CriteriaColumn As Integer
   Dim CurrentRow As Long, i As Long, j As Long
   
   fRegion = "Калининград"
   CriteriaColumn = 3
   
   arrData = Sheets("Data").Cells(1, 1).CurrentRegion.Value
   ReDim arrResult(1 To UBound(arrData, 1), 1 To UBound(arrData, 2))
   
   i = 1
   CurrentRow = 1
   For j = 1 To UBound(arrData, 2)
       arrResult(CurrentRow, j) = arrData(i, j)
   Next j
   CurrentRow = CurrentRow + 1
   
   For i = 2 To UBound(arrData, 1)
       If arrData(i, CriteriaColumn) = fRegion Then
           For j = 1 To UBound(arrData, 2)
               arrResult(CurrentRow, j) = arrData(i, j)
           Next j
           CurrentRow = CurrentRow + 1
       End If
   Next i
   
   With Sheets("result")
       .Cells.Clear
       .Range(.Cells(1, 1), .Cells(CurrentRow, UBound(arrData, 2))).Value = arrResult
   End With
 
End Sub

[ixh7636]

А  можно как то поставить условие чтобы копировал не все столбцы а только те которые уже есть на листе Result (готовая шапка/заголовком)?

[Дмитрий Щербаков(The_Prist)]

Можно. Но какое это имеет отношение к данной теме? Создайте свою, опишите задачу, приложите пример...