Sub EnterDataToWord()
Dim LustRow As Integer, LustColumn As Integer
    
    LustRow = Cells(Rows.Count, 2).End(xlUp).Row
    LustColumn = Cells(2, Columns.Count).End(xlToLeft).Column
    Call WorkWithWord(LustRow, LustColumn)
   
End Sub

Function WorkWithWord(LustRow As Integer, LustColumn As Integer)
Dim File As String
Dim WordApp As Word.Application, WordDoc As Word.Document

File = "Y:\ÐÅÑÓÐÑÛ\ØÀÁËÎÍÛ\Øàáëîí Excel Word\Øàáëîí-Ñïåöèôèêàöèÿ (2015-02-06)2.dotm"
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Open(File)
        
        ActiveWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(LustRow, LustColumn)).Copy
        WordDoc.Activate
        WordDoc.Tables(1).Rows(2).Range.Cells(1).Range.Select
        WordDoc.Tables(1).Cell(2, 1).Range.Select
        
        WordDoc.Range(WordDoc.Tables(1).Cell(2, 1).Range.Start, WordDoc.Tables(1).Cell(2, 1).Range.End).PasteAppendTable
        
    Application.CutCopyMode = False
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
    
End Function

Function MinData(rng As Range, nomb As Integer) As Date

    Dim arr
    Dim j, h As Integer
    Dim rez As Date
    
    arr = rng.Count
    myRow = ActiveCell.Row
        For j = 23 To arr
            myVal = Cells(myRow, j).Value
                If myVal > 0 Then
                    rez = Cells(nomb, j).Value
                    Exit For
                Else
                    rez = 0
                End If
        Next
MinData = rez
End Function

Function SendData(StartRangeData, StartPointToFindData, OpenlLastColumn, dotProject, MainNameBook, OpenBookName, countRowToEnter)
    
line1:
    Workbooks(OpenBookName).Activate
    
    Range(Cells(StartRangeData, 1), Cells(StartPointToFindData - 1, OpenlLastColumn)).Select
    Selection.Copy                                                
    
    Workbooks(MainNameBook).Activate
    Range("B" & dotProject).Select                                 
    On Error GoTo line1
    ActiveSheet.Paste link:=True            <<<<------НА ЭТУ СТРОКУ РУГАЕТСЯ                       
    
    Workbooks(OpenBookName).Activate
    Range(Cells(StartRangeData, 1), Cells(StartRangeData + countRowToEnter - 1, 15)).Select
    Selection.Copy
    
    Workbooks(MainNameBook).Activate
    Range(Cells(dotProject, 2), Cells(dotProject + countRowToEnter - 1, 16)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False                     
    
    Application.CutCopyMode = False                                
    
End Function