Перенос данных на другие листы

@Corovaneer · Регистрация: 23.01.2020

Студворк — интернет-сервис помощи студентам

Добрый день.
К сожалению, знания VBA у меня сильно скудны, а потому написать адекватный макрос не получается.

В общем, требуется автоматическая фильтрация по столбцу H на листе "Лист для выгрузки" в соответствии с листом кодов (код = район).
Затем в трех столбцах из отфильтрованных строк требуется выбрать информацию из столбцов B, С и D (не более 20 строк) и перенести на лист "Опись" в соответствующие графы в столбцах B и C. (Т.е. "Регистрационный номер" в "Регистрационный номер", "ФИО клиента" в "ФИО клиента" и "Адрес доставки" в "Адрес доставки").

И так для каждого из кодов: отфильтровываем столбец H по коду, если что-то есть, то оно нужные столбцы переносятся на другой лист. Проблема в том, что в случае, если фильтр ничего не находит, то вся информация из столбцов переносится на другой лист и с этим ничего не сделать.

Затем фильтры сбрасываются и вся информация по столбцам переносится в "Журнал на сайт" (вот с этим я вроде справился).

Заранее спасибо за помощь!

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub Макрос1()
 
  Sheets("Лист для выгрузки").Select
    ActiveSheet.Range("$A$1:$I$1000").AutoFilter Field:=8, Criteria1:= _
        "40262563000, г. Санкт-Петербург"
    Range("B2").Select
    Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(19, 1)).Select
    Selection.Copy
    Sheets("Опись").Select
    Range("B27:C46").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Лист для выгрузки").Select
    Range("D2").Select
    Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(19, 0)).Select
    Selection.Copy
    Sheets("Опись").Select
    Range("E27:E46").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        ' Далее следует то же самое для других кодов и районов:
        
        Sheets("Лист для выгрузки").Select
    ActiveSheet.Range("$A$1:$I$1000").AutoFilter Field:=8, Criteria1:= _
        "40263561000, г. Санкт-Петербург"
    Range("B2").Select
    Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(19, 1)).Select
    Selection.Copy
    Sheets("Опись").Select
    Range("B63").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Лист для выгрузки").Select
    Range("D2").Select
    Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(19, 0)).Select
    Selection.Copy
    Sheets("Опись").Select
    Range("E63").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
         ' И т.д. Заканчивается переносом в журнал:
        
        ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
        
    Sheets("Лист для выгрузки").Select
    ActiveSheet.Range("$A$1:$I$1000").AutoFilter Field:=8
    Range("A2:G200").Select
    
    Selection.Copy
    Sheets("Журнал на сайт").Select
    Range("B2:H200").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

К сожалению, файл слишком большой, потому запакован в zip.

@Corovaneer · 07.02.2020, 16:52 **[ТС]**

Хм, я просто думал, что там копируется сама форма этой самой описи и переносится направо при заполнении 20 строк, а здесь информация переходит в те описи, что ниже. Видимо, я некорректно выразился. Тогда попробуем работать с таким вариантом.
Спасибо!

Новые блоги и статьи Все статьи Все блоги /
Транскрипция 55-минутного видео через Whisper: WhisperDesktop облажался, спас Google Colab[ anaschu 01.06.2026 Понадобилось получить текст из свежезагруженного видео на YouTube. Казалось бы, задача на пять минут. Заняла полтора часа. Делюсь опытом — может кому пригодится последовательность решений. . . .	21 мат мед. Планы на развитие модели здравоСохранения anaschu 01.06.2026 AnyLogic: план развития симуляционной модели рабочего коллектива — динамический абсентеизм, реальные данные, три сценария сравнения Продолжаю серию постов о дискретно-событийной модели рабочего. . .	20. Мат мед. Абсентеизм как отдельный тип простоя anaschu 29.05.2026 Апдейт модели: исправленные баги, абсентеизм и новые механизмы Продолжаю развивать ранее описанную модель рабочего коллектива на AnyLogic. За последние несколько дней был проведён серьёзный. . .	19. здоровье, усталость и психотип работника влияют на производительность предприятия, и наоборот, производительность на здоровье, усталось и психотип anaschu 28.05.2026 Дискретно-событийная модель рабочего коллектива на AnyLogic: здоровье, выгорание, психотипы и микростимуляция Привет, коллеги. Хочу поделиться итогами нескольких недель работы над симуляционной. . .
"Прокси" для последовательного порта Eddy_Em 28.05.2026 Эту штуку написал я достаточно давно. Но сейчас вот понадобилось настроить датчик грозы, но при этом не отключать его от "метеодемона". Соответственно, надо запустить этот "прокси": метеодемон будет. . .	Рефакторинг программы уравнивания. Massaraksh7 26.05.2026 Пример по предыдущей записи в блоге. Но, надо заметить, что, во-первых, там оптимизация не только математики, но и работы с базой данных, и с графами, а во-вторых, это ещё не всё.	Использование TThread в Lazarus для математических вычислений. Massaraksh7 25.05.2026 Производя рефакторинг своих программ на предмет ускорения их работы, обратил внимание на такой аспект, как сокращение времени матвычислений. Дело в том, что приходится работать с большими матрицами. . .	Модель здравосохранения 18. Чем здоровее работник, тем быстрее выгорает anaschu 24.05.2026 Имитационная модель корпоративного здравоохранения: что показывает математика Сегодня в модели рабочего коллектива на AnyLogic появились три новые механики — выгорание через накопленную усталость,. . .

@Corovaneer 0 / 0 / 0 Регистрация: 23.01.2020 Сообщений: 8
	07.02.2020, 16:52 [ТС]
	Хм, я просто думал, что там копируется сама форма этой самой описи и переносится направо при заполнении 20 строк, а здесь информация переходит в те описи, что ниже. Видимо, я некорректно выразился. Тогда попробуем работать с таким вариантом. Спасибо! 0