Копирование данных по определенным критериям на другой лист.

[Dilmira]

Добрый день!
Помогите написать макрос.
Есть перечень номеров. Номера делятся по складским кодам. Необходимо выбрать несколько складских кодов и перенести этот перечень на другой лист. Обычным фильтром очень долго, и не удобно, так как складских кодов много и меняются они очень редко. Поэтому нужен такой макрос при котором не приходилось бы каждые раз их выбирать. Пробывала написать сама. В принципе он работает но только если перечень не очень большой. А когда нужно обработать много данных он просто переносит весь перечень не фильтруя складские кода.


Sub Перечень()
'
' Перечень Макрос
'

'
Rows("2:2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$2:$L$717").Au toFilter Field:=6, Criteria1:=Array( _
"910003437", "910004689", "910005249", "910005509", "910005579", "910005269", "910005289", "910005309", "910005329", "910005349", "910005369", "910005389", "910005409", "910005449", "910005469", "910005489", "910005529", "910005549", "910005689", "910005779", "910005839", "910003239", "910003279", "910003599", "910003729", "910003849", "910003879", "910003909", "910003949", "910004089", "910004129", "910004359", "910004469", "910004499", "910004529", "910004579", "910004629", "910004659", "910004719", "910004749", "910004779", "910004809", "910005029", "910005059", "910005609", "910005719", "910005809", "910005869", "910003247", "910003287", "910003697", "910003827", "910004097", "910004157", "910004237", "910004607", "910004637", "910004667", "910004707", "910004737", "910005749", "910005777", "910005837", "910005909", "910005929", "910005429"), Operator:=xlFilterValues
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub

[19vitek]

Как вариант.

Sub Кнопка1_Щелчок()
Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
 On Error Resume Next
   Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
       .SpecialCells(xlCellTypeVisible)
 On Error GoTo 0
End With
If rng2 Is Nothing Then
   MsgBox "Нет данных для копирования"
Else
   Worksheets("Лист2").Cells.Clear
   Set rng = ActiveSheet.AutoFilter.Range
   rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
     Destination:=Worksheets("Лист2").Range("A3")
End If
   'ActiveSheet.ShowAllData
    'копирование шапки
    Sheets("Лист1").Select
    Rows("2:2").Select
    Selection.Copy
    Sheets("Лист2").Select
    Rows("2:2").Select
    ActiveSheet.Paste
    Range("P8").Select
End Sub

[Dilmira]

19vitek
Спасибо за ваш код. Но я что-то не поняла где указывать складские кода?

[19vitek]

Ваш файл с моим макросом. В автофильтре на Лист1 выбираете кода и жмете на кнопку. Проверяете результат на 2 листе.

[Dilmira]

Я наверное не совсем правильно обьяснила. Мне нужен макрос в котором мне бы не приходилось выбирать складские кода через фильтр. Так как складских кодов иногда нужно выбрать более 50-ти вручную делать это очень не удобно. Я бы хотела чтобы кода уже были вписаны в макрос или если это возможно включить их в параметры чтобы при необходимости можно было поменять.

[Hugo121]

К сожалению, пример не удаётся посмотреть - что-то с форматом файла.
Может быть делать без автофильтра, а перебором массива -
1. взять список номеров в словарь (например с другого листа или файла)
2. взять в массив обрабатываемые номера
3. скрыть все строки
4. перебором массива (1 проход) и сверкой с словарём открыть нужные строки листа.
5. скопировать видимые
6. открыть все строки

чуть другой алгоритм -
1. взять список номеров в словарь (например с другого листа или файла)
2. взять в массив нужный исходный диапазон листа
3. создать пустой массив высотой с исходный, нужной ширины
4. перебором массива (1 проход) и сверкой с словарём сразу переложить нужные данные из исходного массива в заранее заготовленный, считая количество отобранных строк
5. выгрузить заполненную верхушку нового массива куда угодно

В этих вариантах нет ограничения автофильтра, легко менять список отбираемых номеров, макрос и список могут быть в файле-инструменте, которым можно обработать любой открытый файл.
Работать тоже должно быстро.