Макросы не работают на определенных ПК (subscript out of range)

Function ÏÐÎÏÈÑÜÞ(SourceDigits As Currency) As String
Dim STRNG As String, CHAR, Result As String, Prom As String
Dim I, STRNG_len As Long
Dim SourceDigTail As Currency
SourceDigTail = (SourceDigits - Int(SourceDigits)) * 100
SourceDigits = Int(SourceDigits)
 
STRNG = SourceDigits
STRNG_len = Len(STRNG)
For I = 1 To 9 - STRNG_len Step 1
STRNG = "0" & STRNG
Next I
 
For I = 9 To 9 - STRNG_len + 1 Step -1
CHAR = Mid(STRNG, I, 1)
If CHAR = "" Then GoTo end_c
 
If I = 2 Or I = 5 Or I = 8 Then
If CHAR = "1" Then
CHAR = Mid(STRNG, I, 2)
Select Case CHAR
Case "10"
Prom = "äåñÿòü "
Case "11"
Prom = "îäèííàäöàòü "
Case "12"
Prom = "äâåíàäöàòü "
Case "13"
Prom = "òðèíàäöàòü "
Case "14"
Prom = "÷åòûðíàäöàòü "
Case "15"
Prom = "ïÿòíàäöàòü "
Case "16"
Prom = "øåñòíàäöàòü "
Case "17"
Prom = "ñåìíàäöàòü "
Case "18"
Prom = "âîñåìíàäöàòü "
Case "19"
Prom = "äåâÿòíàäöàòü "
End Select
Else
Select Case CHAR
Case "0"
Prom = " "
Case "2"
Prom = "äâàäöàòü "
Case "3"
Prom = "òðèäöàòü "
Case "4"
Prom = "ñîðîê "
Case "5"
Prom = "ïÿòüäåñÿò "
Case "6"
Prom = "øåñòüäåñÿò "
Case "7"
Prom = "ñåìüäåñÿò "
Case "8"
Prom = "âîñåìüäåñÿò "
Case "9"
Prom = "äåâÿíîñòî "
End Select
End If
End If
If I = 1 Or I = 4 Or I = 7 Then
Select Case CHAR
Case "0"
Prom = ""
Case "1"
Prom = "ñòî "
Case "2"
Prom = "äâåñòè "
Case "3"
Prom = "òðèñòà "
Case "4"
Prom = "÷åòûðåñòà "
Case "5"
Prom = "ïÿòüñîò "
Case "6"
Prom = "øåñòüñîò "
Case "7"
Prom = "ñåìüñîò "
Case "9"
Prom = "äåâÿòüñîò "
End Select
End If
If I = 3 Or I = 6 Or I = 9 Then
 
If I = 9 And Mid(STRNG, I - 1, 1) = "1" Then
Result = " " & Result
GoTo end_c
End If
 
 
 
If I = 3 And Mid(STRNG, I - 1, 1) = "1" Then
Result = "ìèëëèîíîâ " & Result
GoTo end_c
End If
 
 
 
If I = 6 And Mid(STRNG, I - 1, 1) = "1" Then
Result = "òûñÿ÷ " & Result
GoTo end_c
End If
 
Select Case CHAR
Case "0"
Prom = ""
Case "1"
If I = 6 Then
Prom = "îäíà "
Else
Prom = "îäèí "
 
End If
Case "2"
 
If I = 6 Then
Prom = "äâå "
Else
Prom = "äâà "
End If
Case "3"
Prom = "òðè "
 
Case "4"
Prom = "÷åòûðå "
Case "5"
Prom = "ïÿòü "
Case "6"
Prom = "øåñòü "
Case "7"
Prom = "ñåìü "
Case "8"
Prom = "âîñåìü "
Case "9"
Prom = "äåâÿòü "
End Select
End If
Select Case I
 
Case 3
Select Case CHAR
Case "1"
Result = "ìèëëèîí " & Result
Case "2", "3", "4"
Result = "ìèëëèîíà " & Result
Case "5", "6", "7", "8", "9"
Result = "ìèëëèîíîâ " & Result
Case "0"
If STRNG_len > 6 Then
Result = "ìèëëèîíîâ " & Result
End If
End Select
 
 
Case 6
Select Case CHAR
Case "1"
Result = "òûñÿ÷à " & Result
Case "2", "3", "4"
Result = "òûñÿ÷è " & Result
Case "5", "6", "7", "8", "9"
Result = "òûñÿ÷ " & Result
Case "0"
If STRNG_len > 3 Then
Result = "òûñÿ÷ " & Result
End If
End Select
 
Case 9
Select Case CHAR
Case "1"
Result = " " & Result
Case "2", "3", "4"
Result = " " & Result
Case "0", "5", "6", "7", "8", "9"
Result = " " & Result
End Select
End Select
 
Result = Prom & Result
 
end_c:
Next I
 
Rem Result = Format(Mid(Result, 1, 1), " > ") & Mid(Result, 2)
 
Rem ÏÐÎÏÈÑÜÞ = Result & Format(SourceDigTail, "00") & " êîï."
ÏÐÎÏÈÑÜÞ = Result
End Function
 
 
Sub Zayavka()
 Sheets("Çàÿâêà1").Range("a4") = IIf(Sheets("Ëèñò1").Range("a5") = "", "", Sheets("Ëèñò1").Range("a5"))
 Sheets("Çàÿâêà1").Range("f6") = IIf(Sheets("Ëèñò1").Range("f7") = "", "", Sheets("Ëèñò1").Range("f7"))
 Sheets("Çàÿâêà1").Range("a8") = IIf(Sheets("Ëèñò1").Range("e9") = "", IIf(Sheets("Ëèñò1").Range("e10") = "", "", "Âûäàí âçàìåí çàêëþ÷åíèÿ ¹ " & Sheets("Ëèñò1").Range("e10") & " îò " & Sheets("Ëèñò1").Range("l10")), "Äóáëèêàò çàêëþ÷åíèÿ ¹" & Sheets("Ëèñò1").Range("e9") & " îò " & Sheets("Ëèñò1").Range("l9"))
 Sheets("Çàÿâêà1").Range("e10") = IIf(Sheets("Ëèñò1").Range("e11") = "", "", Sheets("Ëèñò1").Range("e11"))
 Sheets("Çàÿâêà1").Range("c11") = IIf(Sheets("Ëèñò1").Range("c12") = "", "", Sheets("Ëèñò1").Range("c12") & ". (ÎÝÇ â Êàëèíèíãðàäñêîé îáëàñòè).")
 Sheets("Çàÿâêà1").Range("c13") = IIf(Sheets("Ëèñò1").Range("c14") = "", "", Sheets("Ëèñò1").Range("c14"))
 Sheets("Çàÿâêà1").Range("d15") = IIf(Sheets("Ëèñò1").Range("d16") = "", "", Sheets("Ëèñò1").Range("d16"))
 Sheets("Çàÿâêà1").Range("i15") = IIf(Sheets("Ëèñò1").Range("l16") = "", "", Sheets("Ëèñò1").Range("l16"))
 Sheets("Çàÿâêà1").Range("d16") = IIf(Sheets("Ëèñò1").Range("d17") = "", "", Sheets("Ëèñò1").Range("d17"))
 Sheets("Çàÿâêà1").Range("f34") = IIf(Sheets("Ëèñò1").Range("f19") = "", "" & "                                                          /" & "                     /", Sheets("Ëèñò1").Range("f19") & " /" & "                     /")
 Sheets("Çàÿâêà1").Range("a36") = IIf(Sheets("Ëèñò1").Range("f19") = "", "ÔÈÎ ëèöà óïîëíîìî÷åííîãî ïîäïèñûâàòü ãðàôó «Äåêëàðàöèÿ çàÿâèòåëÿ» __________________", "ÔÈÎ ëèöà óïîëíîìî÷åííîãî ïîäïèñûâàòü ãðàôó «Äåêëàðàöèÿ çàÿâèòåëÿ» " & Sheets("Ëèñò1").Range("f19"))
 Sheets("Çàÿâêà1").Range("a37") = IIf(Sheets("Ëèñò1").Range("d20") = "", "ïî äîâåðåííîñòè ¹______________ îò ", "ïî äîâåðåííîñòè ¹" & Sheets("Ëèñò1").Range("d20"))
 Sheets("Çàÿâêà1").Range("e37") = IIf(Sheets("Ëèñò1").Range("g20") = "", "", " îò " & Sheets("Ëèñò1").Range("g20"))
 Sheets("Çàÿâêà1").Range("c38") = IIf(Sheets("Ëèñò1").Range("c21") = "", "", Sheets("Ëèñò1").Range("c21"))
 
zap_zay (ss)
 
Sheets("Çàÿâêà1").Select
Range("A1:J1").Select
     
 
End Sub
Sub zap_zay(ss)
Dim dl2, dl3, dl4, dl5, dl6
Dim l2, l3, l4, l5, l6
Dim s2, s3, s4, s5, s6
Dim d_r2, d_r3, d_r4, d_r5, d_r6
Dim st, kk
Dim prob2, ch2, prob3, ch3, prob4, ch4, prob5, ch5, prob6, ch6
 
clear_pageZ (s)
 
Sheets("var").Select
l2 = Range("b2")
l3 = Range("b3")
l4 = Range("b4")
l5 = Range("b5")
l6 = Range("b6")
 
n = 1 ' ëèñò 1
 
st = 0
If n = 1 Then
    kk = 18 'ïîëå ñ êîòîðîé íà÷èíàåòñÿ òàáëèöà
    rr = 33 'ïîëå îêîí÷àíèå òàáëèöà
End If
    Sheets("Ëèñò1").Select
    For I = 24 To 224 '103
    '49
    If Len(Trim(Range("b" & I))) = 0 Then
       Exit For
    End If
        dl2 = Len(Trim(Range("b" & I)))
        If dl2 > l2 Then
                s2 = Int(dl2 / l2) + 1
            Sheets("var").Range("c2") = s2
        Else
            Sheets("var").Range("c2") = 1
        End If
        dl3 = Len(Trim(Range("f" & I)))
        If dl3 > l3 Then
                s3 = Int(dl3 / l3) + 1
            Sheets("var").Range("c3") = s3
        Else
            Sheets("var").Range("c3") = 1
        End If
        dl4 = Len(Trim(Range("h" & I)))
        If dl4 > l4 Then
                s4 = Int(dl4 / l4) + 1
            Sheets("var").Range("c4") = s4
        Else
            Sheets("var").Range("c4") = 1
        End If
        dl5 = Len(Trim(Range("l" & I)))
        If dl5 > l5 Then
                s5 = Int(dl5 / l5) + 1
            Sheets("var").Range("c5") = s5
        Else
            Sheets("var").Range("c5") = 1
        End If
        dl6 = Len(Trim(Range("m" & I)))
        If dl6 > l6 Then
                s6 = Int(dl6 / l6) + 1
            Sheets("var").Range("c6") = s6
        Else
            Sheets("var").Range("c6") = 1
        End If
        Max = Sheets("var").Range("c1") '!
        
        d_r2 = 1
        d_r3 = 1
        d_r4 = 1
        d_r5 = 1
        d_r6 = 1
        
        ch2 = 0
        ch3 = 0
        ch4 = 0
        ch5 = 0
        ch6 = 0
        
        For j = 1 To Max
            
         If st < rr - kk Then
            st = st + 1
         Else
            kk = 4
            rr = 58
            n = n + 1
            'n = 2
            st = 0
            
            ' kolontituly
            'kolont (n)
            ' kolontituly
            
            
         End If
          If j = 1 Then
            Sheets("Çàÿâêà" & Trim(Str(n))).Range("a" & st + kk) = Sheets("Ëèñò1").Range("a" & I)
          End If
          
          'opisanie
          If Len(Sheets("Ëèñò1").Range("b" & I)) < l2 + 1 And j = 1 Then
            Sheets("Çàÿâêà" & Trim(Str(n))).Range("b" & st + kk) = Sheets("Ëèñò1").Range("b" & I)
            d_r2 = d_r2 + l2 + 1
          Else
            kd_r2 = d_r2 + l2
            prob2 = Mid(Sheets("Ëèñò1").Range("b" & I), kd_r2, 1)
            If (prob2 <> " " And prob2 <> "." And prob2 <> "," And prob2 <> ";" And prob2 <> ":" And prob2 <> "") Then
                zz2 = kd_r2
                Do While prob2 <> " " And prob2 <> "." And prob2 <> "," And prob2 <> ";" And prob2 <> ":"
                    kd_r2 = kd_r2 - 1
                    prob2 = Mid(Sheets("Ëèñò1").Range("b" & I), kd_r2, 1)
                
                    If kd_r2 - d_r2 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r2 - d_r2 > 1 Then
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("b" & st + kk) = Mid(Sheets("Ëèñò1").Range("b" & I), d_r2, kd_r2 - d_r2 + 1)
                'ch2 = kd_r2
                d_r2 = kd_r2 + 1 '!
              Else
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("b" & st + kk) = Mid(Sheets("Ëèñò1").Range("b" & I), d_r2, zz2 - kd_r2 + 1)
                d_r2 = zz2 + 1
                ch2 = zz2 - kd_r2
              End If
            Else
              Sheets("Çàÿâêà" & Trim(Str(n))).Range("b" & st + kk) = Mid(Sheets("Ëèñò1").Range("b" & I), d_r2, l2 + 1) '!
              d_r2 = d_r2 + l2 + 1
              'ch2 = d_r2
              
            End If
          End If
          'opisanie
          
          'kol_mest
          If Len(Sheets("Ëèñò1").Range("f" & I)) < l3 + 1 And j = 1 Then
            Sheets("Çàÿâêà" & Trim(Str(n))).Range("f" & st + kk) = Sheets("Ëèñò1").Range("f" & I)
            d_r3 = d_r3 + l3 + 1
          Else
            kd_r3 = d_r3 + l3
            prob3 = Mid(Sheets("Ëèñò1").Range("f" & I), kd_r3, 1)
           
            If (prob3 <> " " And prob3 <> "." And prob3 <> "," And prob3 <> ";" And prob3 <> ":" And prob3 <> "") Then
                zz3 = kd_r3
                Do While prob3 <> " " And prob3 <> "." And prob3 <> "," And prob3 <> ";" And prob3 <> ":"
                    kd_r3 = kd_r3 - 1
                    prob3 = Mid(Sheets("Ëèñò1").Range("f" & I), kd_r3, 1)
                    If kd_r3 - d_r3 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r3 - d_r3 > 1 Then
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("f" & st + kk) = Mid(Sheets("Ëèñò1").Range("f" & I), d_r3, kd_r3 - d_r3 + 1)
                'ch3 = kd_r3
                d_r3 = kd_r3 + 1  '!
              Else
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("f" & st + kk) = Mid(Sheets("Ëèñò1").Range("f" & I), d_r3, zz3 - kd_r3 + 1)
                d_r3 = zz3 + 1
                ch3 = zz3 - kd_r3
              End If
            Else
              Sheets("Çàÿâêà" & Trim(Str(n))).Range("f" & st + kk) = Mid(Sheets("Ëèñò1").Range("f" & I), d_r3, l3 + 1) '!
              d_r3 = d_r3 + l3 + 1
              'ch3 = d_r3
            End If
          End If
          'kol_mest
          
          'kritery
          
          If Len(Sheets("Ëèñò1").Range("h" & I)) < l4 + 1 And j = 1 Then
            Sheets("Çàÿâêà" & Trim(Str(n))).Range("h" & st + kk) = Sheets("Ëèñò1").Range("h" & I)
            d_r4 = d_r4 + l4 + 1
          Else
            kd_r4 = d_r4 + l4
            prob4 = Mid(Sheets("Ëèñò1").Range("h" & I), kd_r4, 1)
           
            If (prob4 <> " " And prob4 <> "." And prob4 <> "," And prob4 <> ";" And prob4 <> ":" And prob4 <> "") Then
                zz4 = kd_r4
                Do While prob4 <> " " And prob4 <> "." And prob4 <> "," And prob4 <> ";" And prob4 <> ":"
                    kd_r4 = kd_r4 - 1
                    prob4 = Mid(Sheets("Ëèñò1").Range("h" & I), kd_r4, 1)
                    If kd_r4 - d_r4 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r4 - d_r4 > 1 Then
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("h" & st + kk) = Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, kd_r4 - d_r4 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, kd_r4 - ch4))  '!!
                'ch4 = kd_r4 '!
                d_r4 = kd_r4 + 1 '!
              Else
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("h" & st + kk) = Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, zz4 - kd_r4 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, zz4 - kd_r4 + 1))
                d_r4 = zz4 + 1
                ch4 = zz4 - kd_r4
              End If
            Else
              Sheets("Çàÿâêà" & Trim(Str(n))).Range("h" & st + kk) = Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, l4 + 1)  '!
              'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4 + 1, l4 - 1))
              d_r4 = d_r4 + l4 + 1
              'ch4 = d_r4
            End If
          End If
          'kritery
          
          'koltov
          If Len(Sheets("Ëèñò1").Range("l" & I)) < l5 + 1 And j = 1 Then
            Sheets("Çàÿâêà" & Trim(Str(n))).Range("i" & st + kk) = Sheets("Ëèñò1").Range("l" & I)
            d_r5 = d_r5 + l5 + 1
          Else
            kd_r5 = d_r5 + l5
            prob5 = Mid(Sheets("Ëèñò1").Range("l" & I), kd_r5, 1)
           
            If (prob5 <> " " And prob5 <> ";" And prob5 <> ":" And prob5 <> "" And prob5 <> "/") Then
                zz5 = kd_r5
                Do While prob5 <> " " And prob5 <> ";" And prob5 <> ":" And prob5 <> "/"
                    kd_r5 = kd_r5 - 1
                    prob5 = Mid(Sheets("Ëèñò1").Range("l" & I), kd_r5, 1)
                    If kd_r5 - d_r5 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r5 - d_r5 > 1 Then
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("i" & st + kk) = Mid(Sheets("Ëèñò1").Range("l" & I), d_r5, kd_r5 - d_r5 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, kd_r4 - ch4))  '!!
                'ch5 = kd_r5 '!
                d_r5 = kd_r5 + 1 '!
              Else
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("i" & st + kk) = Mid(Sheets("Ëèñò1").Range("l" & I), d_r5, zz5 - kd_r5 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, zz4 - kd_r4 + 1))
                d_r5 = zz5 + 1
                ch5 = zz5 - kd_r5
              End If
            Else
              Sheets("Çàÿâêà" & Trim(Str(n))).Range("i" & st + kk) = Mid(Sheets("Ëèñò1").Range("l" & I), d_r5, l5 + 1)  '!
              'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4 + 1, l4 - 1))
              d_r5 = d_r5 + l5 + 1
              'ch5 = d_r5
            End If
          End If
          
          'koltov
          
          'schetf
          If Len(Sheets("Ëèñò1").Range("m" & I)) < l6 + 1 And j = 1 Then
            Sheets("Çàÿâêà" & Trim(Str(n))).Range("j" & st + kk) = Sheets("Ëèñò1").Range("m" & I)
            d_r6 = d_r6 + l6 + 1
          Else
            kd_r6 = d_r6 + l6
            prob6 = Mid(Sheets("Ëèñò1").Range("m" & I), kd_r6, 1)
           
            'If (prob6 <> " " And prob6 <> "." And prob6 <> "," And prob6 <> ";" And prob6 <> ":" And prob6 <> "" And prob6 <> "/") Then
            If (prob6 <> " " And prob6 <> "," And prob6 <> ";" And prob6 <> ":" And prob6 <> "" And prob6 <> "/") Then
                zz6 = kd_r6
                'Do While prob6 <> " " And prob6 <> "." And prob6 <> "," And prob6 <> ";" And prob6 <> ":" And prob6 <> "/"
                Do While prob6 <> " " And prob6 <> "," And prob6 <> ";" And prob6 <> ":" And prob6 <> "/"
                    kd_r6 = kd_r6 - 1
                    prob6 = Mid(Sheets("Ëèñò1").Range("m" & I), kd_r6, 1)
                    If kd_r6 - d_r6 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r6 - d_r6 > 1 Then
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("j" & st + kk) = Mid(Sheets("Ëèñò1").Range("m" & I), d_r6, kd_r6 - d_r6 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, kd_r4 - ch4))  '!!
                'ch6 = kd_r6 '!
                d_r6 = kd_r6 + 1 '!
              Else
                Sheets("Çàÿâêà" & Trim(Str(n))).Range("j" & st + kk) = Mid(Sheets("Ëèñò1").Range("m" & I), d_r6, zz6 - kd_r6 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, zz4 - kd_r4 + 1))
                d_r6 = zz6 + 1
                ch6 = zz6 - kd_r6
              End If
            Else
              Sheets("Çàÿâêà" & Trim(Str(n))).Range("j" & st + kk) = Mid(Sheets("Ëèñò1").Range("m" & I), d_r6, l6 + 1)  '!
              'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4 + 1, l4 - 1))
              d_r6 = d_r6 + l6 + 1
              'ch6 = d_r6
            End If
          End If
          'schetf
          
          
         If j = Sheets("var").Range("c1") And Sheets("var").Range("c1") <> 1 Then
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("b" & I), d_r2, l2))) > 0 Then
                j = j - 1
            End If
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("f" & I), d_r3, l3))) > 0 Then
                j = j - 1
            End If
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, l4))) > 0 Then
                j = j - 1
            End If
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("l" & I), d_r5, l5))) > 0 Then
                j = j - 1
            End If
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("m" & I), d_r6, l6))) > 0 Then
                    j = j - 1
            End If
          End If
 
        Next j
        
        
      Sheets("var").Range("c2") = 0
      Sheets("var").Range("c3") = 0
      Sheets("var").Range("c4") = 0
      Sheets("var").Range("c5") = 0
      Sheets("var").Range("c6") = 0
      If st > rr - 1 Then
        Exit For
      End If
    Next I
 
End Sub
 
Sub Pechat1()
Dim dl2, dl3, dl4, dl5, dl6
Dim l2, l3, l4, l5, l6
Dim s2, s3, s4, s5, s6
Dim d_r2, d_r3, d_r4, d_r5, d_r6, kd_r2
Dim st, kk
Dim prob2, ch2, prob3, ch3, prob4, ch4, prob5, ch5, prob6, ch6
 
clear_page (s)
 
Sheets("var").Select
l2 = Range("b2")
l3 = Range("b3")
l4 = Range("b4")
l5 = Range("b5")
l6 = Range("b6")
 
n = 1 ' ëèñò 1
 
st = 0
If n = 1 Then
    kk = 10 'ïîëå ñ êîòîðîé íà÷èíàåòñÿ òàáëèöà
    rr = 36 'ïîëå îêîí÷àíèå òàáëèöà
End If
    Sheets("Ëèñò1").Select
    For I = 24 To 224 '103
    '49
    If Len(Trim(Range("b" & I))) = 0 Then
       Exit For
    End If
        dl2 = Len(Trim(Range("b" & I)))
        If dl2 > l2 Then
                s2 = Int(dl2 / l2) + 1
            Sheets("var").Range("c2") = s2
        Else
            Sheets("var").Range("c2") = 1
        End If
        dl3 = Len(Trim(Range("f" & I)))
        If dl3 > l3 Then
                s3 = Int(dl3 / l3) + 1
            Sheets("var").Range("c3") = s3
        Else
            Sheets("var").Range("c3") = 1
        End If
        dl4 = Len(Trim(Range("h" & I)))
        If dl4 > l4 Then
                s4 = Int(dl4 / l4) + 1
            Sheets("var").Range("c4") = s4
        Else
            Sheets("var").Range("c4") = 1
        End If
        dl5 = Len(Trim(Range("l" & I)))
        If dl5 > l5 Then
                s5 = Int(dl5 / l5) + 1
            Sheets("var").Range("c5") = s5
        Else
            Sheets("var").Range("c5") = 1
            
        End If
        dl6 = Len(Trim(Range("m" & I)))
        If dl6 > l6 Then
                s6 = Int(dl6 / l6) + 1
            Sheets("var").Range("c6") = s6
        Else
            Sheets("var").Range("c6") = 1
        End If
        Max = Sheets("var").Range("c1") '!
        
        d_r2 = 1
        d_r3 = 1
        d_r4 = 1
        d_r5 = 1
        d_r6 = 1
        
        ch2 = 0
        ch3 = 0
        ch4 = 0
        ch5 = 0
        ch6 = 0
        
        For j = 1 To Max
            
         If st < rr - kk Then
            st = st + 1
            kolont (n)
         Else
            kk = 3
            rr = 39
            n = n + 1
            st = 0
            
            ' kolontituly
            kolont (n)
            ' kolontituly
         End If
         
         
         
          If j = 1 Then
            Sheets("Ïå÷àòü" & Trim(Str(n))).Range("b" & st + kk) = Sheets("Ëèñò1").Range("a" & I)
          End If
          
 
          'opisanie
          If Len(Trim(Sheets("Ëèñò1").Range("b" & I))) < l2 + 1 And j = 1 Then
            Sheets("Ïå÷àòü" & Trim(Str(n))).Range("d" & st + kk) = Sheets("Ëèñò1").Range("b" & I)
            'MsgBox ("1=" & Sheets("Ëèñò1").Range("b" & I))
            d_r2 = d_r2 + l2 + 1
          Else
            kd_r2 = d_r2 + l2
            prob2 = Mid(Sheets("Ëèñò1").Range("b" & I), kd_r2, 1)
            If (prob2 <> " " And prob2 <> "." And prob2 <> "," And prob2 <> ";" And prob2 <> ":" And prob2 <> "") Then
                zz2 = kd_r2
                Do While prob2 <> " " And prob2 <> "." And prob2 <> "," And prob2 <> ";" And prob2 <> ":"
                    kd_r2 = kd_r2 - 1
                    prob2 = Mid(Sheets("Ëèñò1").Range("b" & I), kd_r2, 1)
                    If kd_r2 - d_r2 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r2 - d_r2 > 1 Then
 
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("d" & st + kk) = Mid(Trim(Sheets("Ëèñò1").Range("b" & I)), d_r2, kd_r2 - d_r2 + 1)
 
                d_r2 = kd_r2 + 1 '!
              Else
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("d" & st + kk) = Mid(Sheets("Ëèñò1").Range("b" & I), d_r2, zz2 - kd_r2 + 1)
                MsgBox ("3=" & Mid(Sheets("Ëèñò1").Range("b" & I), d_r2, zz2 - kd_r2 + 1))
                d_r2 = zz2 + 1
                ch2 = zz2 - kd_r2
              End If
            Else
              Sheets("Ïå÷àòü" & Trim(Str(n))).Range("d" & st + kk) = Mid(Sheets("Ëèñò1").Range("b" & I), d_r2, l2 + 1) '!
              d_r2 = d_r2 + l2 + 1
            End If
          End If
          'opisanie
          
          'kol_mest
          If Len(Sheets("Ëèñò1").Range("f" & I)) < l3 + 1 And j = 1 Then
            Sheets("Ïå÷àòü" & Trim(Str(n))).Range("i" & st + kk) = Sheets("Ëèñò1").Range("f" & I)
            d_r3 = d_r3 + l3 + 1
          Else
            kd_r3 = d_r3 + l3
            prob3 = Mid(Sheets("Ëèñò1").Range("f" & I), kd_r3, 1)
           
            If (prob3 <> " " And prob3 <> "." And prob3 <> "," And prob3 <> ";" And prob3 <> ":" And prob3 <> "") Then
                zz3 = kd_r3
                Do While prob3 <> " " And prob3 <> "." And prob3 <> "," And prob3 <> ";" And prob3 <> ":"
                    kd_r3 = kd_r3 - 1
                    prob3 = Mid(Sheets("Ëèñò1").Range("f" & I), kd_r3, 1)
                    If kd_r3 - d_r3 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r3 - d_r3 > 1 Then
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("i" & st + kk) = Mid(Sheets("Ëèñò1").Range("f" & I), d_r3, kd_r3 - d_r3 + 1)
                'ch3 = kd_r3
                d_r3 = kd_r3 + 1  '!
              Else
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("i" & st + kk) = Mid(Sheets("Ëèñò1").Range("f" & I), d_r3, zz3 - kd_r3 + 1)
                d_r3 = zz3 + 1
                ch3 = zz3 - kd_r3
              End If
            Else
              Sheets("Ïå÷àòü" & Trim(Str(n))).Range("i" & st + kk) = Mid(Sheets("Ëèñò1").Range("f" & I), d_r3, l3 + 1) '!
              d_r3 = d_r3 + l3 + 1
              'ch3 = d_r3
            End If
          End If
          'kol_mest
          
          'kritery
          
          If Len(Sheets("Ëèñò1").Range("h" & I)) < l4 + 1 And j = 1 Then
            Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & st + kk) = Sheets("Ëèñò1").Range("h" & I)
            d_r4 = d_r4 + l4 + 1
          Else
            kd_r4 = d_r4 + l4
            prob4 = Mid(Sheets("Ëèñò1").Range("h" & I), kd_r4, 1)
           
            If (prob4 <> " " And prob4 <> "." And prob4 <> "," And prob4 <> ";" And prob4 <> ":" And prob4 <> "") Then
                zz4 = kd_r4
                Do While prob4 <> " " And prob4 <> "." And prob4 <> "," And prob4 <> ";" And prob4 <> ":"
                    kd_r4 = kd_r4 - 1
                    prob4 = Mid(Sheets("Ëèñò1").Range("h" & I), kd_r4, 1)
                    If kd_r4 - d_r4 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r4 - d_r4 > 1 Then
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & st + kk) = Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, kd_r4 - d_r4 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, kd_r4 - ch4))  '!!
                'ch4 = kd_r4 '!
                d_r4 = kd_r4 + 1 '!
              Else
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & st + kk) = Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, zz4 - kd_r4 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, zz4 - kd_r4 + 1))
                d_r4 = zz4 + 1
                ch4 = zz4 - kd_r4
              End If
            Else
              Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & st + kk) = Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, l4 + 1)  '!
              'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4 + 1, l4 - 1))
              d_r4 = d_r4 + l4 + 1
              ch4 = d_r4
            End If
          End If
          'kritery
          
          'koltov
          If Len(Sheets("Ëèñò1").Range("l" & I)) < l5 + 1 And j = 1 Then
            Sheets("Ïå÷àòü" & Trim(Str(n))).Range("n" & st + kk) = Sheets("Ëèñò1").Range("l" & I)
            d_r5 = d_r5 + l5 + 1
          Else
            kd_r5 = d_r5 + l5
            prob5 = Mid(Sheets("Ëèñò1").Range("l" & I), kd_r5, 1)
           
            If (prob5 <> " " And prob5 <> ";" And prob5 <> ":" And prob5 <> "" And prob5 <> "/") Then
                zz5 = kd_r5
                Do While prob5 <> " " And prob5 <> ";" And prob5 <> ":" And prob5 <> "/"
                    kd_r5 = kd_r5 - 1
                    prob5 = Mid(Sheets("Ëèñò1").Range("l" & I), kd_r5, 1)
                    If kd_r5 - d_r5 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r5 - d_r5 > 1 Then
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("n" & st + kk) = Mid(Sheets("Ëèñò1").Range("l" & I), d_r5, kd_r5 - d_r5 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, kd_r4 - ch4))  '!!
                'ch5 = kd_r5 '!
                d_r5 = kd_r5 + 1 '!
              Else
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("n" & st + kk) = Mid(Sheets("Ëèñò1").Range("l" & I), d_r5, zz5 - kd_r5 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, zz4 - kd_r4 + 1))
                d_r5 = zz5 + 1
                ch5 = zz5 - kd_r5
              End If
            Else
              Sheets("Ïå÷àòü" & Trim(Str(n))).Range("n" & st + kk) = Mid(Sheets("Ëèñò1").Range("l" & I), d_r5, l5 + 1)  '!
              'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4 + 1, l4 - 1))
              d_r5 = d_r5 + l5 + 1
              'ch5 = d_r5
            End If
          End If
          
          'koltov
          
          'schetf
          If Len(Sheets("Ëèñò1").Range("m" & I)) < l6 + 1 And j = 1 Then
            Sheets("Ïå÷àòü" & Trim(Str(n))).Range("p" & st + kk) = Sheets("Ëèñò1").Range("m" & I)
            d_r6 = d_r6 + l6 + 1
          Else
            kd_r6 = d_r6 + l6
            prob6 = Mid(Sheets("Ëèñò1").Range("m" & I), kd_r6, 1)
           
            If (prob6 <> " " And prob6 <> "," And prob6 <> ";" And prob6 <> ":" And prob6 <> "" And prob6 <> "/") Then
            'If (prob6 <> " " And prob6 <> "." And prob6 <> "," And prob6 <> ";" And prob6 <> ":" And prob6 <> "" And prob6 <> "/") Then
                zz6 = kd_r6
                'Do While prob6 <> " " And prob6 <> "." And prob6 <> "," And prob6 <> ";" And prob6 <> ":" And prob6 <> "/"
                Do While prob6 <> " " And prob6 <> "," And prob6 <> ";" And prob6 <> ":" And prob6 <> "/"
                    kd_r6 = kd_r6 - 1
                    prob6 = Mid(Sheets("Ëèñò1").Range("m" & I), kd_r6, 1)
                    If kd_r6 - d_r6 = 1 Then
                        Exit Do
                    End If
                Loop
              If kd_r6 - d_r6 > 1 Then
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("p" & st + kk) = Mid(Sheets("Ëèñò1").Range("m" & I), d_r6, kd_r6 - d_r6 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, kd_r4 - ch4))  '!!
               ' ch6 = kd_r6 '!
                d_r6 = kd_r6 + 1 '!
              Else
                Sheets("Ïå÷àòü" & Trim(Str(n))).Range("p" & st + kk) = Mid(Sheets("Ëèñò1").Range("m" & I), d_r6, zz6 - kd_r6 + 1)
                'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, zz4 - kd_r4 + 1))
                d_r6 = zz6 + 1
                ch6 = zz6 - kd_r6
              End If
            Else
              Sheets("Ïå÷àòü" & Trim(Str(n))).Range("p" & st + kk) = Mid(Sheets("Ëèñò1").Range("m" & I), d_r6, l6 + 1)  '!
              'MsgBox (Mid(Sheets("Ëèñò1").Range("h" & I), d_r4 + 1, l4 - 1))
              d_r6 = d_r6 + l6 + 1
              'ch6 = d_r6
            End If
          End If
          'schetf
          
          
          
          
          If j = Sheets("var").Range("c1") And Sheets("var").Range("c1") <> 1 Then
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("b" & I), d_r2, l2))) > 0 Then
                j = j - 1
            End If
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("f" & I), d_r3, l3))) > 0 Then
                j = j - 1
            End If
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, l4))) > 0 Then
                j = j - 1
            End If
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("l" & I), d_r5, l5))) > 0 Then
                j = j - 1
            End If
            If Len(Trim(Mid(Sheets("Ëèñò1").Range("m" & I), d_r6, l6))) > 0 Then
                    j = j - 1
            End If
          End If
          
          
            
            'Sheets("Ïå÷àòü" & Trim(Str(n))).Range("i" & st + kk) = Mid(Sheets("Ëèñò1").Range("f" & I), d_r3, l3)
            'd_r3 = d_r3 + l3
            'Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & st + kk) = Mid(Sheets("Ëèñò1").Range("h" & I), d_r4, l4)
            'd_r4 = d_r4 + l4
            'Sheets("Ïå÷àòü" & Trim(Str(n))).Range("n" & st + kk) = Mid(Sheets("Ëèñò1").Range("k" & I), d_r5, l5)
            'd_r5 = d_r5 + l5
            'Sheets("Ïå÷àòü" & Trim(Str(n))).Range("p" & st + kk) = Mid(Sheets("Ëèñò1").Range("l" & I), d_r6, l6)
            'd_r6 = d_r6 + l6
         'End If
        Next j
        
        
      Sheets("var").Range("c2") = 0
      Sheets("var").Range("c3") = 0
      Sheets("var").Range("c4") = 0
      Sheets("var").Range("c5") = 0
      Sheets("var").Range("c6") = 0
      If st > rr - 1 Then
        Exit For
      End If
    Next I
 
 
    'asd = Mid(Range("b" & i), 1, 10)
    
'    asd = Mid(Ëèñò1!b2, 1, 10)
'    MsgBox (asd)
 
 '   Ëèñò1!a2 = 123
    'Range("B3").Select
    'Selection.Copy
    'Sheets("Ïå÷àòü" & Trim(Str(n))).Select
    'Range("B3").Select
    'ActiveSheet.Paste
 
Sheets("Ïå÷àòü1").Select
Range("A1:J1").Select
End Sub
 
 
Sub kolont(n)
'MsgBox (n)
If n = 1 Then
    Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l2") = "2003" & Sheets("Ëèñò1").Range("c2")
    If Sheets("Ëèñò1").Range("c12") = "" Then
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("b3") = ""
    Else
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("b3") = Trim(Sheets("Ëèñò1").Range("c12")) & ". (ÎÝÇ â Êàëèíèíãðàäñêîé îáëàñòè)"
    End If
    If Sheets("Ëèñò1").Range("c14") = "" Then
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("b6") = ""
    Else
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("b6") = Trim(Sheets("Ëèñò1").Range("c14"))
    End If
'ÅÑËÈ(Ëèñò1!E9="";ÅÑËÈ(Ëèñò1!E10="";"";"Âûäàí âçàìåí çàêëþ÷åíèÿ ¹ "&&amp;#203;èñò1!E10&" îò "&&amp;#203;èñò1!K10);"Äóáëèêàò çàêëþ÷åíèÿ ¹"&&amp;#203;èñò1!E9&" îò "&&amp;#203;èñò1!K9)
    If Sheets("Ëèñò1").Range("e9") = "" Then
        If Sheets("Ëèñò1").Range("e10") = "" Then
            Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j6") = ""
        Else
            Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j6") = "Âûäàíî âçàìåí Çàêëþ÷åíèÿ ôîðìû ÒÒÑ ¹ " & Trim(Sheets("Ëèñò1").Range("e10")) & " îò " & Sheets("Ëèñò1").Range("l10")
        End If
    Else
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j6") = "Äóáëèêàò çàêëþ÷åíèÿ ¹" & Trim(Sheets("Ëèñò1").Range("e9")) & " îò " & Sheets("Ëèñò1").Range("l9")
    End If
 
End If
 
Sheets("Ïå÷àòü" & Trim(Str(n))).Range("k1") = "2003" & Sheets("Ëèñò1").Range("c2")
 
 'ÅÑËÈ(Ëèñò1!O22=0;"";"Êîëè÷åñòâî äîï. ëèñòîâ "&&amp;#203;èñò1!O22&" ("&&amp;#239;ðîïèñüþ(Ëèñò1!O22)&")")
    'If Sheets("Ëèñò1").Range("o22") = 0 Then
    'MsgBox (n)
    If n = 1 Then
        Sheets("Ïå÷àòü" & Trim(Str(1))).Range("j7") = ""
    Else
        Sheets("Ïå÷àòü" & Trim(Str(1))).Range("j7") = "Êîëè÷åñòâî äîï. ëèñòîâ " & Trim(Str(n - 1)) & " (" & Trim(ÏÐÎÏÈÑÜÞ(Str(n - 1))) & ")"
        'Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j7") = "Êîëè÷åñòâî äîï. ëèñòîâ " & Sheets("Ëèñò1").Range("o22") & " (" & Trim(ÏÐÎÏÈÑÜÞ(Sheets("Ëèñò1").Range("o22"))) & ")"
    End If
 
If n = 1 Then
q = 0
Else
q = 2
End If
'    "&"Êàëèíèíãðàäñêàÿ ÒÏÏ"
    Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & Trim(Str(39 + q))) = "    " & "Êàëèíèíãðàäñêàÿ ÒÏÏ"
    Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & Trim(Str(40 + q))) = "    " & "ã. Êàëèíèíãðàä, óë. Âàòóòèíà, 20"
    Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & Trim(Str(41 + q))) = "    " & "ò. 8 4012 590660"
 
'=ÅÑËÈ(Ëèñò1!D16="";"";"      "&&amp;#203;èñò1!K16&"          "&&amp;#203;èñò1!D16)
    If Sheets("Ëèñò1").Range("d16") = "" Then
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & Trim(Str(45 + q))) = ""
    Else
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("l" & Trim(Str(45 + q))) = "      " & Sheets("Ëèñò1").Range("l16") & "         " & Sheets("Ëèñò1").Range("d16")
    End If
    
    If Sheets("Ëèñò1").Range("d17") = "" Then
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j" & Trim(Str(47 + q))) = ""
    Else
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j" & Trim(Str(47 + q))) = Trim(Sheets("Ëèñò1").Range("d17"))
    End If
    
    If Sheets("Ëèñò1").Range("l2") = "" Then
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j" & Trim(Str(51 + q))) = ""
    Else
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j" & Trim(Str(51 + q))) = Trim(Sheets("Ëèñò1").Range("l2"))
    End If
    
    If Sheets("Ëèñò1").Range("f19") = "" Then
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("b" & Trim(Str(51 + q))) = ""
    Else
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("b" & Trim(Str(51 + q))) = Trim(Sheets("Ëèñò1").Range("f19"))
    End If
    
    If Sheets("Ëèñò1").Range("e3") = "" Then
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("b" & Trim(Str(53 + q))) = ""
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j" & Trim(Str(53 + q))) = ""
    Else
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("b" & Trim(Str(53 + q))) = "  " & (Sheets("Ëèñò1").Range("e3"))
        Sheets("Ïå÷àòü" & Trim(Str(n))).Range("j" & Trim(Str(53 + q))) = "  " & (Sheets("Ëèñò1").Range("e3"))
    End If
End Sub
 
Sub clear_page(s)
For n = 1 To 20
    Sheets("Ïå÷àòü" & Trim(Str(n))).Range("a1:x87") = ""
Next n
End Sub
Sub clear_pageZ(s)
For n = 1 To 20
    If n = 1 Then
        Sheets("Çàÿâêà" & Trim(Str(n))).Range("a19:j33") = ""
    Else
        Sheets("Çàÿâêà" & Trim(Str(n))).Range("a4:j58") = ""
    End If
Next n
End Sub

Sheets("лИсТ2").activate

Sub Zayavka()
Workbooks("Арсенал").Activate