Существует таблица в первом листе (1st sheet). Эту таблицу надо разделить на страницы по регионам, например Москва в одном, Питер в другом листе и т.д. У меня на примере есть макрос (спасибо Kuzmich - у) но надо делать изменения. (дает дебуг)И макросе можно так сделать чтобы там строки или столбцы тоже я сам определил. Потому что может быть этот макрос ещё понадобится мне в других книгах тоже. Заранее спасибо
Код
Sub iTown()
Dim i As Long
Dim n As Integer
Dim Criterij As String
Dim iName As String
Dim Sht As Worksheet
Application.ScreenUpdating = False
Set Sht = ThisWorkbook.Worksheets("MH-2019")
Columns("E").ClearContents
Range("C3:C" & Cells(Rows.Count, "C").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy _
, CopyToRange:=Range("E3"), Unique:=True
n = Cells(Rows.Count, "E").End(xlUp).Row
For i = 4 To n 'цикл по уникальным значениям
Criterij = Sht.Cells(i, "E")
iName = Criterij 'имя нового листа
Sht.Range("A3:C" & Cells(Rows.Count, "C").End(xlUp).Row).AutoFilter 3, Criterij
Sht.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
With Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'добавляет новый лист в конец
.Range("A1:C1").PasteSpecial xlPasteColumnWidths
.Range("A1:C1").PasteSpecial xlPasteFormats
.Range("A1:C1").PasteSpecial xlPasteValues
Sht.AutoFilter.Range.AutoFilter
.Name = iName
.Range("A1").Select
End With
Next
Application.ScreenUpdating = True
End Sub
У вас язык азербайджанский я так понял. В ходе написания макроса надо быть внимательным. Некоторые символы могут не поддерживаться.
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок. А в том, чтобы писать программы, работающие при любом количестве ошибок.
Sub iTown()
Dim i As Long
Dim n As Integer
Dim Criterij As String
Dim iName As String
Dim Sht As Worksheet
Application.ScreenUpdating = False
Set Sht = ThisWorkbook.Worksheets("MH-2019")
Columns("E").ClearContents
'отбор уникальных значений столбца C в столбец E
Range("C3:C" & Cells(Rows.Count, "C").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy _
, CopyToRange:=Range("E3"), Unique:=True
'количество уникальных значений городов
n = Cells(Rows.Count, "E").End(xlUp).Row
For i = 4 To n 'цикл по уникальным значениям
Criterij = Sht.Cells(i, "E")
iName = Criterij 'имя нового листа
'ставим автофильтр по столбцу C
Sht.Range("A3:C" & Cells(Rows.Count, "C").End(xlUp).Row).AutoFilter 3, Criterij
'копируем видимые строки в новый лист
Sht.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy
With Worksheets.Add(After:=Worksheets(Worksheets.Count)) 'добавляет новый лист в конец
.Range("A1:C1").PasteSpecial xlPasteColumnWidths
.Range("A1:C1").PasteSpecial xlPasteFormats
.Range("A1:C1").PasteSpecial xlPasteValues
Sht.AutoFilter.Range.AutoFilter
.Name = iName
.Range("A1").Select
End With
Next
Application.ScreenUpdating = True
End Sub
mk92, У вас при копировании кода с форума и вставке его в модуль произошли какие-то ошибки. Копировать и вставлять нужно при русской раскладке клавиатуры (не уверен, что она у вас есть) Посмотрите в приложенном архиве пример макроса. Я оставил только три города, остальную таблицу добавьте сами. Удачи!