y = Workbooks (tb). Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

Private Sub zapolnit()
    nm = TEST.DOC
    gd = ActiveWorkbook.Sheets(1).Range("A1")
    pr = ActiveWorkbook.Sheets(1).Range("B1")

    Set objWord = CreateObject("word.application")
    objWord.Visible = True
    Set objDoc = objWord.Documents.Open(ActiveWorkbook.Path & nm)
    
    Call telo
    
    objDoc.SaveAs2 Filename:=ActiveWorkbook.Path & "\Rezult\" & Left(nm, 5) & "_" & Format(gd, "00") & Format(pr, "00") & ".docx"
    objWord.Quit
End Sub
Private Sub telo()

For bMi = 1 To objDoc.Bookmarks.Count
        If (Len(objDoc.Bookmarks(bMi).Name) - Len(Replace(objDoc.Bookmarks(bMi).Name, "_", ""))) <> 4 Then GoTo NxtBM
        tmpBM = Split(objDoc.Bookmarks(bMi).Name, "_")
        If IsSh(tmpBM(LBound(tmpBM)) & "") = False Then GoTo NxtBM
        Set sh1 = ThisWorkbook.Sheets(tmpBM(LBound(tmpBM)) & "")
        rOw1 = Val(tmpBM(LBound(tmpBM) + 1))
        rOw2 = Val(tmpBM(LBound(tmpBM) + 2))
        cOl1 = Val(tmpBM(LBound(tmpBM) + 3))
        cOl2 = Val(tmpBM(LBound(tmpBM) + 4))
        objDoc.Bookmarks(bMi).Range.Select
        For i = rOw1 To rOw2
            Set r = objWord.Selection.Range
            For j = cOl1 To cOl2
                If Len(sh1.Cells(i, j).Value) = 0 Then
                    objWord.Selection.TypeText Text:="0"
                Else
                    If sh1.Cells(i, j).Value = 0 Then
                        objWord.Selection.TypeText Text:=" "
                    Else
                        objWord.Selection.TypeText Text:=CStr(sh1.Cells(i, j).Value)
                    End If
                End If
                If j <> cOl2 Then objWord.Selection.MoveRight unit:=wdCell
            Next j
            r.Select
            If i <> rOw2 Then objWord.Selection.MoveDown 'unit:=wdCell
        Next i

NxtBM:
    Next bMi
For bMi = 1 To objDoc.Bookmarks.Count
        If (Len(objDoc.Bookmarks(bMi).Name) - Len(Replace(objDoc.Bookmarks(bMi).Name, "_", ""))) <> 1 Then GoTo NxtgBM
        tmpBM = Split(objDoc.Bookmarks(bMi).Name, "_")
            If Mid(tmpBM(0), 1, 3) = "god" Then
                If tmpBM(0) = "god1" Then
                    objDoc.Bookmarks(bMi).Range.Select
                    objWord.Selection = Mid(Format(gd, "00"), 1, 1)
                        GoTo NxtgBM
                Else: objDoc.Bookmarks(bMi).Range.Select
                    objWord.Selection = Mid(Format(gd, "00"), 2, 2)
                        GoTo NxtgBM
                End If
            ElseIf Mid(tmpBM(0), 1, 3) = "mon" Then
                If tmpBM(0) = "mon1" Then
                    objDoc.Bookmarks(bMi).Range.Select
                    objWord.Selection = Mid(Format(pr, "00"), 1, 1)
                        GoTo NxtgBM
                Else: objDoc.Bookmarks(bMi).Range.Select
                    objWord.Selection = Mid(Format(pr, "00"), 2, 2)
                        GoTo NxtgBM
                End If
            End If
            
                        
NxtgBM:
    Next bMi
End Sub
Function IsSh(shN As String) As Boolean
Dim tmpobj As Worksheet
IsSh = False
On Error GoTo FIN
Set tmpobj = ThisWorkbook.Sheets(shN)
IsSh = True
FIN:
End Function

Dim p As String, f As String, wb As Workbook, ws As Worksheet
          Application.ScreenUpdating = False: Application.DisplayAlerts = False
    With ThisWorkbook
        p = .Path & "\": f = Dir(p & "*.csv*")
        Do While f <> ""
            If .Name <> f Then
            Workbooks.OpenText Filename:=p & f, DataType:=xlDelimited, Tab:=False, Semicolon:=True, Comma:=False, local:=True
                Set ws = Sheets(1)
                On Error Resume Next: .Sheets(ws.Name).Delete: On Error GoTo 0
                ws.Copy After:=.Sheets(.Sheets.Count): ws.Parent.Close False
            End If
            f = Dir
        Loop
        .Sheets(1).Activate
    End With

Dim FileN$
FileN = ThisWorkbook.Path & "\" & "Result.xls"
ThisWorkbook.sheets(1).Copy
ActiveWorkbook.SaveCopyAs FileN
ActiveWorkbook.close SaveChanges:=False

Sub probel()
With range ("A1:Z204" & Cells(Rows.Count, 1).end (xlup).row)
.value=application.trim(application.clean(.value))
End with 
End sub