Sub Макрос1()

Dim n As Range
Dim i As Integer, f As Integer, q As Integer
Dim l As Long
Dim g As Long
Dim p As Integer
Dim o As Long

q = 0
f = 0
i = 2
l = 6
g = 19
p = 0

For f = f To 179
q = q + 1
p = p + 1

Set n = Cells(i, "I")
Cells(i, "I").Select

If n = 1 Then

Sheets("Лист2").Select

Range("A" & l & ":C" & g).Select 'копирует выделенный диапазон'
Selection.Copy
Sheets("Лист1").Select ' переходит на другой лист и вставляет'
Range("A6").Select
Selection.Insert Shift:=xlDown

MkDir ("D:\Macros\M" & "\" & q) 'создает папку в существеющую папку'

Sheets("Лист2").Select 'удаляет скопированую часть таблицы'
Range("A6").Select
Range("A" & l & ":C" & g).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

ThisWorkbook.SaveAs Filename:="D:\Macros\M" & "\" & q & "\" & q & ".xlsx", FileFormat:=51 'сохраняет файл'

Sheets("Лист1").Select 'удаляет скопированое для следуещего копирования'
Range("A6").Select
Range("A" & l & ":C" & g).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

l = 6
g = 12

i = i + 1

MsgBox True

Else

Sheets("Лист2").Select
Range("A6").Select

l = l + 8
g = g + 8

Cells(i, "I").Select
i = i + 1

MsgBox False

End If

Next f

End Sub