Shell "C:\Program Files\LibreOffice\program\soffice  --convert-to doc --outdir ""C:\с ошибкой"" ""C:\с ошибкой\Решение.odt""", vbNormalFocus

Function ТЕКСТWORD(wfn As String) As String 'Получить текст из Word
    Dim objWrdApp, objWrdDoc, Tabl As Object, i As Long
    On Error Resume Next
        Set objWrdApp = GetObject(, "Word.Application")
        If objWrdApp Is Nothing Then
            Set objWrdApp = CreateObject("Word.Application")
            Set objWrdDoc = objWrdApp.Documents.Open(wfn)
            objWrdApp.Visible = False
        End If
        Set objWrdDoc = objWrdApp.Documents.Open(wfn)
        ТЕКСТWORD = objWrdDoc.Range.Text
        objWrdDoc.Close SaveChanges:=False
        Set objWrdDoc = Nothing
        Set objWrdApp = Nothing
End Function

ActiveCell.Offset(, 1).Interior.Color = vbRed

Sub Extract_TD_text()     
    Set IE = New InternetExplorer
    IE.Visible = True
    For i = 1 To Worksheets(ShRN).Cells(Rows.Count, 1).End(xlUp).Row
        URL = Worksheets(ShRN).Cells(i, 1).Value
        IE.navigate URL
        While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE: DoEvents: Wend
        Set HTMLDoc = IE.Document        
        For Each ele In HTMLDoc.all.tags("table")
          ...
        Next
        Set HTMLDoc = Nothing
    Next i
    IE.Quit
    Set IE = Nothing
End Sub

Cells(.Row + n, 3).Value = Cells(.Row + n - 1, 3).Value + 1

Sub qq()
    LR = Worksheets("Дополнение кодов").Cells(Rows.Count, 1).End(xlUp).Row + 1
    For i = 12 To Worksheets("Планировщик").Cells(Rows.Count, 1).End(xlUp).Row
    E = True
        For j = 2 To Worksheets("Дополнение кодов").Cells(Rows.Count, 1).End(xlUp).Row
            If Worksheets("Планировщик").Cells(i, 1).Value = Worksheets("Дополнение кодов").Cells(j, 1).Value Then E = False: Exit For
        Next j
    If E Then Worksheets("Дополнение кодов").Cells(LR, 1).Value = Worksheets("Планировщик").Cells(i, 1).Value: LR = LR + 1
    Next i
End Sub

Sub qq()
    LR = Worksheets("Планировщик").Cells(Rows.Count, 1).End(xlUp).Row + 1
    For i = 2 To Worksheets("Дополнение кодов").Cells(Rows.Count, 1).End(xlUp).Row
   
    E = True
        For j = 12 To Worksheets("Планировщик").Cells(Rows.Count, 1).End(xlUp).Row
            If Worksheets("Планировщик").Cells(j, 1).Value = Worksheets("Дополнение кодов").Cells(i, 1).Value Then E = False: Exit For
        Next j
    If E Then Worksheets("Планировщик").Cells(LR, 1).Value = Worksheets("Дополнение кодов").Cells(i, 1).Value: LR = LR + 1
    Next i
End Sub

Sub Combine()
    Dim s As Worksheet
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Combined"
        For Each s In ActiveWorkbook.Sheets
            If s.Name <> "Combined" Then
                i = i + 1
                Sheets(1).Range("A" & i).Value = s.Range("C1").Value
            End If
        Next
End Sub

UserForm1.Show vbModeless

ЛЕВСИМВ(RC[3];RC[4];ПОИСК(" г";RC[3];RC[4])-1))

q = 1
For i = 1 To poslcol
    If Data = Sheets("2015").Cells(1, i).Value Then
    'Col = i
         For Z = 2 To poslrow
            If Sheets("2015").Cells(10 + Z, i) = "" Then
                For x = q To poslrow
                    If Sheets("zaz 2015").Cells(x + 1, 17) = "a" Then
                        'Row = x
                        Sheets("2015").Cells(10 + Z, i) = Sheets("zaz 2015").Cells(x + 1, 11)
                        q = x + 1
                        Exit For
                   End If
                Next x
            End If
        Next Z
    End If
Next i

For i = 1 To poslcol
    If Data = Sheets("2015").Cells(1, i).Value Then
    'Col = i
         For Z = 2 To poslrow
            If Sheets("2015").Cells(10 + Z, i) = "" Then
                
                    If Sheets("zaz 2015").Cells(Z + 1, 17) = "a" Then
                        'Row = x
                        Sheets("2015").Cells(10 + Z, i) = Sheets("zaz 2015").Cells(Z + 1, 11)
                       
                   End If
              
            End If
        Next Z
    End If
Next i