Sub Мяу()
Dim bkm$
bkm = InputBox("Введите имя закладки")
On Error GoTo err_
If VarType(b) = vbBoolean Then Exit Sub
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:=bkm
.DefaultSorting = wdSortByName
.ShowHidden = True
End With

Dim objExcel As Object
Dim FileName$
FileName = "C:\Documents and Settings\Андр\Мои документы\0.xls"
Set objExcel = CreateObject("Excel.Application")
DoEvents
With objExcel
.DisplayAlerts = False
With .Workbooks.Open(FileName)
DoEvents
.sheets(1).Hyperlinks.Add Anchor:=.sheets(1).Range("A1"), _
Address:=ActiveDocument.FullName, _
SubAddress:=bkm, _
TextToDisplay:=ActiveDocument.FullName
.Save
.Close
End With
.DisplayAlerts = False
End With
Set objExcel = Nothing

On Error GoTo 0
Exit Sub
err_:
MsgBox Err.Description
On Error GoTo 0
End Sub

Range("A1")

Cells(Rows.Count,1).End(xlUp).Row

Sub Мяуу() ' Создание закладки в Word для выделенного диапазона с последующим созданием гиперссылки в заданном документе Excel на созданную закладку
Dim bkm$                    ' Задаем переменную для названия закладки
Dim lLastRow As Long                    ' Задаем переменную для номера последнего непустого столбца
bkm = InputBox("Введите номер задания")                         ' Окно с названием закладки, заодно и текст ссылки
On Error GoTo err_
With ActiveDocument.Bookmarks                    ' Для активного документа
.Add Range:=Selection.Range, Name:=bkm
.DefaultSorting = wdSortByName
ActiveDocument.Save
.ShowHidden = True
End With
Dim objExcel As Object
Dim FileName$
FileName = "C:\Users\user\Desktop\Книга1.xlsm"
Set objExcel = CreateObject("Excel.Application")
DoEvents
With objExcel
.DisplayAlerts = False
With .Workbooks.Open(FileName)
DoEvents
lLastRow = .sheets(1).UsedRange.Row + .sheets(1).UsedRange.Rows.Count
.sheets(1).Hyperlinks.Add Anchor:=.sheets(1).Range("A" & lLastRow), Address:=ActiveDocument.FullName, SubAddress:=bkm, TextToDisplay:=bkm
.Save
.Close
End With
.DisplayAlerts = False
End With
Set objExcel = Nothing
On Error GoTo 0
Exit Sub
err_:
MsgBox Err.Description
On Error GoTo 0
End Sub