Новости:

Теперь на форум можно залогиниться / зарегистрироваться с помощью ВКонтакте. Уже существующие пользователи могут связать свою учетную запись с аккаунтом ВКонтакте одним кликом в профиле пользователя http://forum.msexcel.ru/index.php?action=profile;area=account

Главное меню

Изменения в макросе (разбивка листа на файлы по критерию)

Автор Skristina, 09.03.2015, 01:54

« назад - далее »

Skristina

Доброе время суток!
На форуме нашла решение моей проблемы: макрос, который разбивает данные на листе на файлы по критерию. (см. вложение)
Но он не совсем мне подходит. Я работаю с таблицами с гораздо большим количеством столбцов, а в колонку G выводится список, по которому формируются файлы. И я никак не могу его сдвинуть (к примеру, в колонку ВА), везде меняю G на ВА и макрос перестает работать (((
Пожалуйста, помогите  :'(

ShAM

И Вам здравствуйте.
Здесь: Gorod = Cells(i, 7) поменяли на: Gorod = Cells(i, 53)?
7 - это столбец G, 53 - это столбец BA.
У меня так работает: Public nw As Workbook
Sub Создать()
    Range("BA1:BA30").ClearContents
    PS = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1:A" & PS).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BA3"), Unique:=True
    Range("BA4:BA30").Font.ColorIndex = 5
MsgBox "Создали уникальный список городов"
    Range("A1:E1").AutoFilter
    SG = Range("BA" & Rows.Count).End(xlUp).Row
    For i = 4 To SG
       Gorod = Cells(i, 53)
       Range("A1:E1").AutoFilter Field:=1, Criteria1:=Gorod
MsgBox "Отсортировали по г. " & Gorod & " и копируем на Лист2"
       Range("A2:E" & PS).SpecialCells(xlVisible).Copy Sheets("Лист2").Range("A2")
MsgBox "Cоздаем файл [" & Gorod & "] с данными Лист2"
      '*****************
       ThisWorkbook.Worksheets("Лист2").Copy
       iFullName = ThisWorkbook.Path & "\" & Gorod & ".xls"
       ActiveWorkbook.SaveAs FileName:=iFullName
       ActiveWorkbook.Close
      'Здесь код макроса по созданию файла с данными Листа2.
      '*****************
MsgBox "Возвращаемся на Лист1"
       Sheets("Лист2").Range("A2:G65000").ClearContents
       Range("A1:E1").AutoFilter
    Next
    Range("BA4:BA30").ClearContents
    MsgBox "В С Е !!!"
End Sub


Skristina

Вот это я ....
И искала же где может быть прописан столбец и в упор не видела.
Спасибо большое!!! Вы даже не представляете, на сколько эта штука облегчит мне жизнь!
УРА-УРА-УРА!!!!

буду его дальше под себя подстраивать... ))))
Еще раз спасибо!!!