.Hyperlinks.Add Anchor:=.Cells(iLastRow, 3), Address:=sNewFolderName12 & "\" & sNewFileName12, TextToDisplay:=Me.TextBox1.Text
.Hyperlinks.Add Anchor:=.Cells(iLastRow, 13), Address:=sNewFolderName13 & "\" & sNewFileName13, TextToDisplay:=Me.TextBox7.Text

Private Sub Workbook_Open()
Dim Arr, sSh
Arr = Array("Лист1", "Лист2")
For Each sSh In Arr
Protect_for_User_Non_for_VBA Me.Sheets(sSh)
Next
End Sub
Sub Protect_for_User_Non_for_VBA(wsSh As Worksheet)
wsSh.Protect Password:="1111", AllowFiltering:=True, UserInterfaceOnly:=True
End Sub

' Создание папки
Dim nf As Object
Dim nFolder As String
Set nf = CreateObject("Scripting.FileSystemObject")
nFolder = "D:\" & Cells(iLastRow, 1)
If Not nf.FolderExists(nFolder) Then
nf.CreateFolder (nFolder)
End If
' Переименовать файл
Dim objFSO As Object, objFile As Object
Dim sFileName12 As String, sNewFileName12 As String
sFileName12 = UserForm1.TextBox12.Text
sNewFileName12 = iLastRow - 2 & "KP.pdf"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(sFileName12) = False Then
MsgBox "Такого файла не существует", vbCritical, "Внимание"
Exit Sub
End If
Set objFile = objFSO.GetFile(sFileName12)
objFile.Name = sNewFileName12
MsgBox "Файл переименован", vbInformation, "Сообщение"

Dim sNewFolderName12 As String
sFileName12 = "D:\" & sNewFileName12
sNewFolderName12 = nFolder  
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(sFileName12) = False Then
MsgBox "Такого файла не существует", vbCritical, "Внимание"
Exit Sub
End If
Set objFile = objFSO.GetFile(sFileName12)
objFile.Move sNewFolderName12 ' при ошибке выделяется эта строка. (см. фото)
MsgBox "Файл перемещен", vbInformation, "Сообщение"

Dim nFolder As Object
Set nFolder = CreateObject("Scripting.FileSystemObject")
With nFolder
.CreateFolder ("D:\" & Cells(iLastRow, 1))
For i = 1 To 1
Next
End With

Dim objFSO As Object, objFile As Object
Dim sFileName12 As String, sNewFileName12 As String
sFileName12 = UserForm1.TextBox12.Text
sNewFileName12 = iLastRow - 2 & "KP.pdf"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(sFileName12) = False Then
MsgBox "Такого файла не существует", vbCritical, "Внимание"
Exit Sub
End If
Set objFile = objFSO.GetFile(sFileName12)
objFile.Name = sNewFileName12
MsgBox "Файл переименован", vbInformation, "Сообщение"

Dim sNewFolderName12 As String
sFileName12 = "D:\" & sNewFileName12
sNewFolderName12 = nFolder  ' адрес куда перемещать - см. фото ошибки (во вложении)
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(sFileName12) = False Then
MsgBox "Такого файла не существует", vbCritical, "Внимание"
Exit Sub
End If
Set objFile = objFSO.GetFile(sFileName12)
objFile.Move sNewFolderName12
MsgBox "Файл перемещен", vbInformation, "Сообщение"

Private Sub Workbook_Open()
Dim iLastRow As Long
Dim i As Integer
With Sheet("Пример")
iLastRow = .Cells(Rows.Count, 5).End(xlDown).Row
For i = 3 To iLastRow
If .Cells(i, 5).Value <= Date Then
.Range("A" & i & ":G" & i).Interior.Color = RGB(255, 225, 225)
End If
End With
End Sub

Private Sub CommandButton1_Click()
Dim iLastRow As Long
Dim i As Integer
With Sheets("Пример")
    iLastRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
        For i = 3 To iLastRow - 1
        Next i
    .Cells(iLastRow, 2) = Me.ComboBox1
'    .Cells(iLastRow, 3) = Me.TextBox1
    Sheets("Пример").Hyperlinks.Add Anchor:=Cells(iLastRow, 3), _
     Address:=Me.TextBox4.Value, _
     TextToDisplay:=Me.TextBox1.Value
    
    .Cells(iLastRow, 4) = Me.TextBox6
    .Cells(iLastRow, 5) = CDate(Me.TextBox10.Value)
    .Cells(iLastRow, 6) = CDate(Me.TextBox2.Value)
    .Cells(iLastRow, 7) = Me.ComboBox2
End With

    iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
    Cells(iLastRow, 1) = iLastRow - 2
    ComboBox1.SetFocus
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton1_Click()
Dim i As Integer
With Worksheets("Лист1")
    i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1

Worksheets("Лист1").Hyperlinks.Add Anchor:=Cells(i, 1), _
     Address:=UserForm1.TextBox2.Value, _
     TextToDisplay:=UserForm1.TextBox1.Value
End With
End Sub

Private Sub CommandButton1_Click()
With Worksheets("Лист1")
    i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Cells(i, 1) = UserForm1.TextBox1.Value
    .Cells(i, 2) = UserForm1.TextBox2.Value
End With
'Очистка формы для дальнейшего ввода данных
Me.TextBox1 = ""
Me.TextBox1.BackColor = &H80000005
Me.TextBox2 = ""
Me.TextBox2.BackColor = &H80000005
End Sub

Private Sub UserForm_Initialize()
     With TextBox2 'кнопка для доп информации
        .DropButtonStyle = fmDropButtonStyleReduce  'вид кнопки
        .ShowDropButtonWhen = fmShowDropButtonWhenAlways    'показывать кнопку
     End With
End Sub

Private Sub TextBox2_DropButtonClick()
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "PDF files", "*.pdf*"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show = 0 Then Exit Sub
        TextBox2 = .SelectedItems(1)
    End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim Result
  If Target.Cells.Count > 1 Then Exit Sub Else Cancel = True
  With Target
    Result = MsgBox("Пример", vbYesNo + 64)
    If Result = vbYes Then
Cells(Target.Row, 6) = "From: " & Target
    Else
    End If
  End With
End Sub

Sub CommandButton1_Click()
If WindowsLogin("UserName", "Password", GetDomainName) Then
     TextBox1.Value = "Успешно"
Else
MsgBox "Ошибка", 64, "Внимание"
Exit Sub
End If
End Sub

Function GetDomainName()
Dim Info
     Set Info = CreateObject("AdSystemInfo")
     GetDomainName = Info.DomainDNSName
End Function

Function WindowsLogin(ByVal strUserName As String, ByVal strpassword As String, ByVal strDomain As String) As Boolean
     On Error GoTo IncorrectPassword
Dim oADsObject, oADsNamespace As Object, ADSI As Object
Dim strADsPath As String
     Set ADSI = CreateObject("ADSystemInfo")
     strADsPath = "LDAP://" & strDomain
     Set oADsNamespace = GetObject("LDAP:")
     Set oADsObject = oADsNamespace.OpenDSObject(strADsPath, ADSI.UserName, strpassword, 0)
     WindowsLogin = True
ExitSub:
     Exit Function
IncorrectPassword:
     WindowsLogin = False
     Resume ExitSub
End Function

Dim WshNetwork As Object, sCompName As String, oUser As Object, sName
Set WshNetwork = CreateObject("WScript.Network")
sCompName = WshNetwork.ComputerName  'получаем имя компа
sName = WshNetwork.UserName          'получаем имя текущего пользователя
On Error Resume Next
'sName - имя пользователя на компьюторе
Set oUser = WshNetwork.GetObject("WinNT://" & sCompName & "/" & sName)
oUser.ChangePassword PassOld, "2584"
'ввод нового пароля
oUser.SetInfo

Private Sub CommandButton1_Click()
Dim n1 As Long, n2 As Long
Dim K_, F_, I_, O_
K_ = UserForm1.TextBox1.Text
n1 = InStr(1, K_, " ")
n2 = InStr(n1 + 1, K_, " ")
F_ = Left(K_, n1 - 1)
I_ = Mid(K_, n1 + 1, n2 - n1 - 1)
O_ = Right(K_, Len(K_) - n2)
    MsgBox I_ & O_, 64, "Сообщение"
End Sub