Создать из одной книги много по шаблону

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Создать из одной книги много по шаблону (Макросы/Sub)

Leko

Дата: Суббота, 03.12.2022, 22:57 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Добрый день, помогите с макросом пожалуйста.

В книге 3 столбца, в столбце А и B значения. В столбце С - порядковый номер реестра.

Надо создать новую книгу которая будет называться номером реестра и содержать в себе данные из первых 2 столбцов соответствующих этому реестру (и желательно заголовок таблицы).
Заранее спасибо

К сообщению приложен файл: __.xlsx (9.4 Kb)

Ответить

Kuzmich

Дата: Воскресенье, 04.12.2022, 11:51 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 713

Репутация: 157 ±

Замечаний: 0% ±

Excel 2003

Цитата

помогите с макросом

[vba]

Код

Sub RaznestiReestr()
Dim i As Long
Dim n As Long
Dim Criterij As String
Dim iName As String
Dim WCur As Worksheet
Dim WbN As Workbook
Dim AutoFilter As AutoFilter
Application.ScreenUpdating = False
   Set WCur = ThisWorkbook.Worksheets("Лист2")
   Columns("E").ClearContents
          'отбор уникальных значений столбца C в столбец E
    Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy _
                    , CopyToRange:=Range("E1"), Unique:=True
          'количество уникальных значений
    n = Cells(Rows.Count, "E").End(xlUp).Row
    For i = 2 To n          'цикл по уникальным значениям
        Criterij = Cells(i, "E")
        iName = "Номер реестра_" & Criterij    'имя новой книги
    'создаем новую книгу с одним листом
      Set WbN = Workbooks.Add(xlWBATWorksheet)
    'ставим автофильтр по столбцу C
          WCur.Range("C1").CurrentRegion.AutoFilter 3, Criterij
    'копируем видимые строки в новую книгу
        WCur.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy WbN.Sheets("Лист1").Range("A1")
        WCur.AutoFilter.Range.AutoFilter

        WbN.Sheets("Лист1").Columns("A:C").AutoFit
        WbN.SaveAs ThisWorkbook.Path & "\" & iName & ".xls"
        WbN.Close SaveChanges:=True
    Next
Application.ScreenUpdating = True
End Sub

[/vba]

Ответить

Leko

Дата: Воскресенье, 04.12.2022, 15:58 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Все сработало, кроме сохранения. Но эту проблему решили.
Спасибо огромное.

Ответить

aladenskikhsergei

Дата: Понедельник, 12.12.2022, 09:51 | Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация: 0 ±

Замечаний: 0% ±

Kuzmich, добрый день
Пользуюсь вашим макросом, все работает отлично, вспоминаю добрым словом каждый день.

Но возникли 2 вопроса:

1. макрос завершает свое выполнение ошибкой, т.к. в конце создает очередной файл, но копировать в него ему нечего и соотв. не может сохранить с определенным именем. можно ли как то сказать ему чтобы при создании файла по последнему условию из цикла, он просто завершал работу без ошибки?

2. пример:
В столбце E указаны названия магазинов, в остальных данные о платежных транзакциях. В ежедневных выгрузках разное число транзакций, и не всегда они есть по всем магазинам. Но есть 4 магазина данные по которым есть в каждой выгрузке.
Задача:
Используя макрос написанный вами выше, нужно также делить данные каждого магазина в отдельный файл, но, можно ли добавить исключение для 4 магазинов по следующему условию - "Маг 12 (оплата)" и "Маг 12 (возврат)" объеденить в 1 файл, вместо двух разных, и также "Маг 18 (оплата)" и "Маг 18 (возвраты)", названия изменил для примера. Названия менять нельзя, т.к. нам нужно видеть деление по оплате и возврату

Буду бесконечно благодарен, если у вас получится помочь

Ответить

СообщениеKuzmich, добрый день
Пользуюсь вашим макросом, все работает отлично, вспоминаю добрым словом каждый день.

Но возникли 2 вопроса:

1. макрос завершает свое выполнение ошибкой, т.к. в конце создает очередной файл, но копировать в него ему нечего и соотв. не может сохранить с определенным именем. можно ли как то сказать ему чтобы при создании файла по последнему условию из цикла, он просто завершал работу без ошибки?

2. пример:
В столбце E указаны названия магазинов, в остальных данные о платежных транзакциях. В ежедневных выгрузках разное число транзакций, и не всегда они есть по всем магазинам. Но есть 4 магазина данные по которым есть в каждой выгрузке.
Задача:
Используя макрос написанный вами выше, нужно также делить данные каждого магазина в отдельный файл, но, можно ли добавить исключение для 4 магазинов по следующему условию - "Маг 12 (оплата)" и "Маг 12 (возврат)" объеденить в 1 файл, вместо двух разных, и также "Маг 18 (оплата)" и "Маг 18 (возвраты)", названия изменил для примера. Названия менять нельзя, т.к. нам нужно видеть деление по оплате и возврату

Буду бесконечно благодарен, если у вас получится помочь

Автор - aladenskikhsergei
Дата добавления - 12.12.2022 в 09:51

Kuzmich

Дата: Понедельник, 12.12.2022, 12:43 | Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 713

Репутация: 157 ±

Замечаний: 0% ±

Excel 2003

А где ваш пример?

Ответить

aladenskikhsergei

Дата: Понедельник, 12.12.2022, 13:42 | Сообщение № 6

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация: 0 ±

Замечаний: 0% ±

Kuzmich, добавил

К сообщению приложен файл: tmp1.xlsm (31.4 Kb)

Ответить

Kuzmich

Дата: Понедельник, 12.12.2022, 14:26 | Сообщение № 7

Группа: Проверенные

Ранг: Ветеран

Сообщений: 713

Репутация: 157 ±

Замечаний: 0% ±

Excel 2003

Цитата

1. макрос завершает свое выполнение ошибкой,

Вы невнимательно скопировали мой макрос
[vba]

Код

' n = Cells(Rows.Count, "E").End(xlUp).Row
n = Cells(Rows.Count, "V").End(xlUp).Row

[/vba]
Вновь создаваемая книга имеет один лист Лист1, а не Sheet1 (хотя м.б. у вас английская версия)
[vba]

Код

' WCur.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy WbN.Sheets("Sheet1").Range("A1")
WCur.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy WbN.Sheets("Лист1").Range("A1")

[/vba]
[vba]

Код

WbN.Sheets("Лист1").Columns("A:N").AutoFit

[/vba]