Макрос, перетаскивающий заказы на отдельные листы

[Дмитрий Котельников]

Привет. Нужен макрос, который будет перетаскивать заказы из одного листа с большим списком на отдельные листы, чтобы каждый заказ был отдельно. Нужно чтобы макрос создавал ровно столько листов с заказами, сколько заказов поступило и переносил только те товары, которые выбрал покупатель, а не весь список. Я приложу экселевский файл. Помогите пожалуйста. Моих знаний хватает только на создание макроса, который будет делать каждый лист по отдельности((((( Бьюсь-мучаюсь-не получается 

[kuklp1]

Код Выделить Развернуть

Public Sub www()
    Dim a, i&, j&, n&
    Application.DisplayAlerts = 0
    Application.ScreenUpdating = 0
    With Sheets("Ответы на форму")
        a = .Range(.[a1], .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(3, _
        .Columns.Count).End(xlToLeft).Column))
    End With
    For i = 4 To UBound(a)
        Sheets("Blank").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        With ActiveSheet
            If WorksheetExist(a(i, 3) & " " & i - 3) Then Worksheets(a(i, 3) & " " & i - 3).Delete
            .Name = a(i, 3) & " " & i - 3
            .[f1] = i - 3: .[f3] = a(i, 1): .[f5] = a(i, 3): .[f7] = a(i, 4)
            .[f9] = a(i, 2): .[f11] = a(i, 5): .[f13] = a(i, UBound(a, 2))
            n = 17
            For j = 6 To UBound(a, 2) - 1
                If a(i, j) <> "" Then
                    n = n + 1
                    .Cells(n, 3) = a(1, j): .Cells(n, 4) = a(2, j): .Cells(n, 5) = a(3, j)
                    .Cells(n, 9) = a(i, j)
                End If
            Next
        End With
    Next
    Sheets("Ответы на форму").Activate
    Application.ScreenUpdating = -1
    Application.DisplayAlerts = -1
End Sub