Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Разделение данных таблицы на отдельные файлы - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разделение данных таблицы на отдельные файлы (Макросы/Sub)
Разделение данных таблицы на отдельные файлы
Elvira66 Дата: Воскресенье, 29.03.2020, 08:06 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый день!
Помогите пожалуйста написать код, нужно данные в таблице разделить на три новых созданных файла ексель по одному уникальному номеру в столбце номер. Заголовок при этом должен остаться во всех файлах.
К сообщению приложен файл: 4924162.xlsx(9.7 Kb)
 
Ответить
СообщениеДобрый день!
Помогите пожалуйста написать код, нужно данные в таблице разделить на три новых созданных файла ексель по одному уникальному номеру в столбце номер. Заголовок при этом должен остаться во всех файлах.

Автор - Elvira66
Дата добавления - 29.03.2020 в 08:06
Kuzmich Дата: Воскресенье, 29.03.2020, 12:14 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 523
Репутация: 106 ±
Замечаний: 0% ±

Excel 2003
Цитата
данные в таблице разделить на три новых созданных файла

[vba]
Код
Sub RaznestiDannye()
Dim i As Long
Dim Criterij As String
Dim iName As String
Dim WbN As Workbook
Dim Autofilter As Autofilter
Dim iLastRow As Long
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Columns("H").ClearContents
      'уникальные из F в столбец H
  Range("F1:F" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True
     iLastRow = Cells(Rows.Count, "H").End(xlUp).Row
    For i = 2 To iLastRow          'цикл по уникальным номерам
        Criterij = Worksheets("Лист1").Cells(i, "H")
        iName = Criterij    'имя новой книги
    'создаем новую книгу с одним листом
    Set WbN = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Worksheets("Лист1").Activate
    'ставим автофильтр по столбцу J
        Range("A1").CurrentRegion.Autofilter 6, Criterij
    'копируем видимые строки в новую книгу
        ActiveSheet.Autofilter.Range.SpecialCells(xlCellTypeVisible).Copy WbN.Sheets("Лист1").Range("A1")
        ActiveSheet.Autofilter.Range.Autofilter
        
        WbN.Sheets("Лист1").Columns("A:F").AutoFit
        WbN.SaveAs ThisWorkbook.Path & "\" & iName & ".xls"
        WbN.Close SaveChanges:=True
    Next
  Columns("H").ClearContents
Application.ScreenUpdating = True
End Sub
[/vba]
Удачи!
 
Ответить
Сообщение
Цитата
данные в таблице разделить на три новых созданных файла

[vba]
Код
Sub RaznestiDannye()
Dim i As Long
Dim Criterij As String
Dim iName As String
Dim WbN As Workbook
Dim Autofilter As Autofilter
Dim iLastRow As Long
  iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Columns("H").ClearContents
      'уникальные из F в столбец H
  Range("F1:F" & iLastRow).AdvancedFilter xlFilterCopy, CopyToRange:=Range("H1"), Unique:=True
     iLastRow = Cells(Rows.Count, "H").End(xlUp).Row
    For i = 2 To iLastRow          'цикл по уникальным номерам
        Criterij = Worksheets("Лист1").Cells(i, "H")
        iName = Criterij    'имя новой книги
    'создаем новую книгу с одним листом
    Set WbN = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Worksheets("Лист1").Activate
    'ставим автофильтр по столбцу J
        Range("A1").CurrentRegion.Autofilter 6, Criterij
    'копируем видимые строки в новую книгу
        ActiveSheet.Autofilter.Range.SpecialCells(xlCellTypeVisible).Copy WbN.Sheets("Лист1").Range("A1")
        ActiveSheet.Autofilter.Range.Autofilter
        
        WbN.Sheets("Лист1").Columns("A:F").AutoFit
        WbN.SaveAs ThisWorkbook.Path & "\" & iName & ".xls"
        WbN.Close SaveChanges:=True
    Next
  Columns("H").ClearContents
Application.ScreenUpdating = True
End Sub
[/vba]
Удачи!

Автор - Kuzmich
Дата добавления - 29.03.2020 в 12:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Разделение данных таблицы на отдельные файлы (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

jooble Яндекс цитирования
© 2010-2020 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!