On Error Resume Next
    Set WordApp = GetObject(, "word.application")
    If WordApp Is Nothing Then
        Set WordApp = CreateObject("word.application")
    End If
    On Error GoTo 0
    With WordApp
        .Visible = False
        .Documents.Open Filename:=sOM
    End With

CreateObject("WScript.Shell").Run 

myExcel = CreateObject("Excel.Application")

 Workbooks(now_book_name).Sheets("Список").Range("B" & i & ":AY" & i) = Workbooks(new_book_name).Sheets("Данные").Range("B2:AY2").Value

Set myExcel = CreateObject("Excel.Application")
    Set myWorkBook = myExcel.Workbooks.Open(sOM)
    new_book_name = myWorkBook.Name
   ' MsgBox new_book_name
   ' MsgBox now_book_name
    myExcel.Visible = True
    Workbooks(now_book_name).Sheets("Список").Range("B" & i & ":AY" & i) = Workbooks(new_book_name).Sheets("Данные").Range("B2:AY2").Value

    myWorkBook.Save
    myWorkBook.Close

=СУММПРОИЗВ((B2:B502>0)*(C2:C502<>"Пример")*1)

=СУММПРОИЗВ((B2:B502>0)*(C2:C502<>"Пример")*((A2:A502=КОНМЕСЯЦА(--A2:A502;0)))*1)
или
=СУММПРОИЗВ(--(B2:B502>0);--(C2:C502<>"Пример");--((A2:A502=КОНМЕСЯЦА(--A2:A502;0))))

znach1=15
$num_state =1
msgbox Eval ("znach"& $num_state) 'Выдаст сообщение "15"

Dim zn$, iArr&(0 To 9), i&, x

For Each x In Split(zn, "|")
    iArr(i) = x
    i = i + 1
Next

ComboBox4.List = Array("1", "2", "3", "4", "5", "6")

ComboBox4.List = Array("")
zn = Replace(zn, "|", """, """) 
zn = """" & zn & """"
ComboBox4.List = Array(zn)
ComboBox4.ListIndex = 0

zn= "D:\test.txt"
Open zn For Input As 1
putt = Input(LOF(1), 1)
Close 1

Sub pdfxx3()

folderPDFexe = "C:\Program Files (x86)\PDFtk\bin\pdftk.exe"
folderPDFout = "D:\1\temp\1.pdf"

folderPDFin1 = "D:\1\1.pdf"
folderPDFin2 = "D:\1\2.pdf"


folderPDFexe = """" & folderPDFexe & """"
folderPDFout = """" & folderPDFout & """"
folderPDFin = """" & folderPDFin & """"


    cmdStr = folderPDFexe & " " & folderPDFin1 & " " & folderPDFin2 & " cat output " & folderPDFout

     
    Shell cmdStr, vbHide



End Sub

Sub pdfxx3()

folderPDFexe = "C:\Program Files (x86)\PDFtk\bin\PdftkXp.exe"
folderPDFout = "D:\1\temp\CCPPF20190701696.pdf"
folderPDFin = "D:\1\*.pdf"

folderPDFin2 = "D:\1\temp\"

folderPDFexe = """" & folderPDFexe & """"
folderPDFout = """" & folderPDFout & """"
folderPDFin = """" & folderPDFin & """"


    cmdStr = folderPDFexe & " " & folderPDFin & " cat output " & folderPDFout
               
     
    Shell cmdStr, vbHide

sFolder = "D:\1\temp\"


End Sub

Sub mergePDF() 'Объединение PDF (PDDoc)
Set PDDoc1 = CreateObject("AcroExch.PDDoc"): file1 = PDDoc1.Create
Папка = [G3]
If Папка = "" Then Папка = Application.ActiveWorkbook.Path & "\Join\"
If Right(Папка, 1) <> "\" Then Папка = Папка & "\"
If Dir(Папка & "_merge.pdf") <> "" Then Kill Папка & "_merge.pdf"
ФайлPDF = Dir(Папка & "*.pdf")
Do Until ФайлPDF = "" 'цикл по всем файлам rtf
pdf = Папка & ФайлPDF
Set PDDoc2 = CreateObject("AcroExch.PDDoc"): file2 = PDDoc2.Open(pdf)
Call PDDoc1.InsertPages(PDDoc1.GetNumPages - 1, PDDoc2, 0, PDDoc2.GetNumPages, 0): PDDoc2.Close
ФайлPDF = Dir 'следующий файл в нашей выборке
Loop
SaveMerge = PDDoc1.Save(PDSaveFull, Папка & "_merge.pdf"): PDDoc1.Close
Set PDDoc1 = Nothing: Set PDDoc2 = Nothing
End Sub

=ДВССЫЛ("D:\"&A1&"\[1.xlsx]Лист1!$C$1")

 Sub del()


Filename = Sheets("Данные").Range("E1").Value
  
   
WIF "4", vbNullString, "Список", Filename 'удаляет "4", а тест оставляет...
WIF "4", "тест", "Список", Filename

 End Sub

Sub aaa()
Set x1 = Application.InputBox(Prompt:="Выберите лист с Названием", Title:="Выбираем любую ячейку на нужном листе", Type:=8)
list1 = x1.Parent.Name
ActiveCell.FormulaR1C1 = "=" & list1 & "!R[2]C[1]"""
End Sub