Option Explicit
Option Base 1
Public Const iCONST_NOTE_ColsStepForPrint = 5 'êîëîíîê â øàïêå ÿðëûêà
Public Const iCONST_NOTE_RowsStepForPrint = 14 'ñòðîê â îäíîé ñòðàíèöå
Public Const iCONST_NOTE_ColAddedPage = 125   'ïåðâàÿ êîëîíêà êîðåøêà

Public Sub DrawNote()

Dim ii As Integer, jj As Integer
Dim iPg As Byte 'òåêóùèé íîìåð ñòðàíèöû


Dim rData As Range          'òåóêùèé äèàïàçîí äëÿ âñòàâêè äàííûõ
Dim rDSourcePage As Range   'òåóêùèé äèàïàçîí- èñòî÷íèê äàííûõ äëÿ îäíîé ñòðàíèöû
Dim rDSourceAll As Range    'äèàïàçîí èñõîäíûõ äàííûõ-èñòî÷íèê

Dim rCap As Range           'òåêóùàÿ øàïêà ÿðëûêà (èëè ñòðàíèöû èëè êîðåøêà)
Dim rCapPage1 As Range      'øàïêà ïåðâîé ÿðëûêà ¹1)
Dim rCSourceAll As Range    'äèàïàçîí ñ øàáëîíàìè øàïîê

Dim irC As Integer, icC As Integer 'íîìåð ñòðîêè è êîëîíêè äëÿ âñòàâêè øàïêè
Dim irD As Integer, irD_End As Integer, icD As Integer 'íîìåð ñòðîêè è êîëîíêè äëÿ âñòàâêè äàííûõ



'ïîäãîòîâêà
shTarget.UsedRange.Rows.Delete 'î÷èùàåì áóäóùèé ëèñò
shTarget.Range("A1:ZZ1").Columns.EntireColumn.Hidden = False
Set rDSourceAll = DrawNote_GetData(shData) 'èñõîäíûå ÄÀÍÍÛÅ - äëÿ êàæäîãî ðÿäà
Set rCSourceAll = shCapShablon.UsedRange 'ññûëêà íà äèàïàçîí ñ øàïêàìè

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If iCONST_NOTE_ColsStepForPrint <> rCSourceAll.Columns.Count Then Debug.Print "basNoteDraw.DrawNote &#207;&#240;&#238;&#226;&#229;&#240;&#252;&#242;&#229; &#234;&#238;&#235;&#232;&#247;&#229;&#241;&#242;&#226;&#238; &#241;&#242;&#238;&#235;&#225;&#246;&#238;&#226; &#237;&#224; &#235;&#232;&#241;&#242;&#229; " & rCSourceAll.Parent.Name
For jj = 1 To rCSourceAll.Rows.Count '&#239;&#229;&#240;&#229;&#225;&#232;&#240;&#224;&#229;&#236; &#242;&#232;&#239;&#251; &#248;&#224;&#239;&#238;&#234; (&#240;&#255;&#228;&#251;)
    If rCSourceAll.Cells(jj, 1) = Empty Then GoTo NextJJ
    Set rCapPage1 = Nothing
    For ii = 1 To rDSourceAll.Rows.Count Step iCONST_NOTE_RowsStepForPrint '&#239;&#229;&#240;&#229;&#225;&#232;&#240;&#224;&#229;&#236; &#228;&#224;&#237;&#237;&#251;&#229; &#228;&#235;&#255; &#226;&#241;&#242;&#224;&#226;&#234;&#232;
        '&#238;&#247;&#232;&#241;&#242;&#234;&#224; &#239;&#229;&#240;&#229;&#236;&#229;&#237;&#237;&#251;&#245; &#241;&#242;&#240;&#224;&#237;&#232;&#246;&#251;
        Set rCap = Nothing: Set rData = Nothing: Set rDSourcePage = Nothing
        irC = 0: icC = 0: irD = 0:  irD_End = 0: icD = 0
        
        '&#237;&#238;&#236;&#229;&#240; &#241;&#242;&#240;&#224;&#237;&#232;&#246;&#251;
        iPg = Application.WorksheetFunction.RoundUp(ii / iCONST_NOTE_RowsStepForPrint, 0)
        
        '&#248;&#224;&#239;&#234;&#224;'''''''''''''''''''''''''''''''''''''''
        irC = iCONST_NOTE_RowsStepForPrint * jj
        icC = iCONST_NOTE_ColsStepForPrint * iPg - iCONST_NOTE_ColsStepForPrint + 1
        Set rCap = shTarget.Range(Cells(irC, icC).Address & ":" & Cells(irC, icC + rCSourceAll.Columns.Count - 1).Address)
        If ii = 1 Then '&#239;&#229;&#240;&#226;&#251;&#233; &#255;&#240;&#235;&#251;&#234; (&#241;&#242;&#240;&#224;&#237;&#232;&#246;&#224;) &#226; &#240;&#255;&#228;&#243;
            rCap.Value = rCSourceAll.Rows(jj).Value: Set rCapPage1 = rCap
            Else
            rCap.FormulaArray = "=" & rCapPage1.Address(False, False, xlR1C1, , rCap.Cells(1, 1))
            End If
        Call DrawNote_Format(rCap)
        
        '&#228;&#224;&#237;&#237;&#251;&#229;'''''''''''''''''''''''''''''''''''''''
        irD = irC + 1: icD = icC
        irD_End = irD + IIf(ii + iCONST_NOTE_RowsStepForPrint - 1 >= rDSourceAll.Rows.Count, rDSourceAll.Rows.Count, ii + iCONST_NOTE_RowsStepForPrint - 1) - ii
        Set rData = shTarget.Range(Cells(irD, icD).Address & ":" & Cells(irD_End, (icD + rCap.Columns.Count - 1)).Address)
        Set rDSourcePage = rDSourceAll.Range(Cells(ii, 1).Address & ":" & Cells(ii + rData.Rows.Count - 1, rData.Columns.Count).Address)
        Debug.Print rData.Address & "  -   " & rDSourcePage.Address
        rData.Value = rDSourcePage.Value
        Call DrawNote_Format(rData)
        
        '&#234;&#238;&#240;&#229;&#248;&#238;&#234; (&#242;&#238;&#235;&#252;&#234;&#238; &#229;&#241;&#235;&#232; &#239;&#238;&#241;&#235;&#229;&#228;&#237;&#255;&#255; &#241;&#242;&#240;&#224;&#237;&#232;&#246;&#224;)
        If iPg <> Application.WorksheetFunction.RoundUp(rDSourceAll.Rows.Count / iCONST_NOTE_RowsStepForPrint, 0) Then GoTo NextII
        shTarget.Range(Cells(1, icC + rCap.Columns.Count + 1).Address & ":" & Cells(1, iCONST_NOTE_ColAddedPage - 1).Address).Columns.EntireColumn.Hidden = IIf(icC + rCap.Columns.Count + 1 < iCONST_NOTE_ColAddedPage - 1, True, False)
        icC = iCONST_NOTE_ColAddedPage
        '&#248;&#224;&#239;&#234;&#224; &#234;&#238;&#240;&#229;&#248;&#234;&#224;
        Set rCap = shTarget.Range(Cells(irC, icC).Address & ":" & Cells(irC, icC + rCSourceAll.Columns.Count - 1).Address)
        rCap.FormulaArray = "=" & rCapPage1.Address(False, False, xlR1C1, , rCap.Cells(1, 1))
        Call DrawNote_Format(rCap)
        '&#228;&#224;&#237;&#237;&#251;&#229; &#234;&#238;&#240;&#229;&#248;&#234;&#224;
        icD = iCONST_NOTE_ColAddedPage
        Set rData = shTarget.Range(Cells(irD, icD).Address & ":" & Cells(irD_End, (icD + rCap.Columns.Count - 1)).Address)
        rData.Value = "1"
        Call DrawNote_Format(rData)
NextII: Next ii
NextJJ:
    Next jj
End Sub