Sub Rename_File()
    Dim objFSO As Object, objFile As Object, objFolder As Object
    Dim sFileName, sNewFileName, OldName, NewName
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    sNewFileName = Range(Cells(2, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2))
    sFileName = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
 
    Set pDialog = Application.FileDialog(msoFileDialogFolderPicker)

    With pDialog
        .Title = "Выбрать папку с файлами" '"заголовок окна диалога
        .ButtonName = "Выбрать папку"
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .InitialFileName = ActiveWorkbook.Path 'ThisWorkbook.Path '"назначаем первую папку отображения
        .InitialView = msoFileDialogViewLargeIcons 'вид диалогового окна(доступно 9 вариантов)
        If .Show = 0 Then Exit Sub 'показывает диалог
    End With
    
      Set objFolder = objFSO.GetFolder(pDialog.SelectedItems(1))
      
    For Each file In objFolder.Files
        For i = 1 To UBound(sFileName)
                If file.Name Like sFileName(i, 1) Then
                
                    sPath = objFolder.Path
                    
                    OldName = file   'старое имя в ячейке
                    NewName = sPath & "\" & sNewFileName(i, 1)  'новое имя
    
                    Set objFile = objFSO.GetFile(file)
                    objFile.Name = sNewFileName(i, 1)
    
                    Name OldName As NewName
       
                End If
         Next i
      Next
      
End Sub

Sub JSht()
Dim myCell As Range, i, L, D, firstAddress As String
Dim wbw As Workbook, ws As Worksheet
Dim range1, cels, range2()

Set wbw = ActiveWorkbook

 ' For Each ws In wbw.Worksheets
    range1 = Range(Cells(3, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, Cells(3, Columns.Count).End(xlToLeft).Column)).Select
    Selection.Replace What:="", Replacement:="0", LookAt:=xlWhole, SearchOrder:=xlByRows


    L = Cells(Rows.Count, 2).End(xlUp).Row
    D = Cells(1, Columns.Count).End(xlToLeft).Column
  
  With Rows(2)
    Set myCell = .Find("Сумм*", , , xlPart)
        If Not myCell Is Nothing Then
            firstAddress = myCell.Address
        End If
    Do
        Set myCell = .FindNext(myCell)
            If Not myCell.Address = firstAddress Then
                    Range(Cells(3, myCell.Column), Cells(L, myCell.Column)).Select
                    Selection.Replace ".", ","
                    i = 3
                        For Each cels In Range(Cells(3, myCell.Column), Cells(L, myCell.Column))
                            If IsNumeric(Cells(i, myCell.Column)) Then
                                Cells(i, myCell.Column) = CCur(cels)
                                Selection.NumberFormat = "#,##0.00;#,##0.00;0"
                            End If
                            i = i + 1
                        Next
            End If
    Loop Until myCell.Address = firstAddress
   End With
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
   If Sh.Name <> "Отчет" Then
        If Not Intersect(Target, [A3:A30]) Is Nothing And Target.Count = 1 Then
           rw = Target.Row
           rwl = Range("A" & rw).Address
          
            With Worksheets("Отчет")
            .ActiveCell Range("rwl")
               ' .Activate rwl
               ' .Range("A" & rw).Val
                Selection.Range ("A" & Target.Row)
                'ActiveCell
            End With
        End If
   Else

Range(Cells(2, 68), Cells(l, 68)).FormulaR1C1 = "=IF($E$4="ИНН",SUMPRODUCT(('Z:\Пользователь01\VBA Программа\2-ВЫГРУЗКА по месяцам\[2019.xlsx]1'!$AP$2:$AP$30000=$A12)*" _
"'Z:\Пользователь01\VBA Программа\2-ВЫГРУЗКА по месяцам\[2019.xlsx]1'!$T$2:$T$30000)+SUMPRODUCT(('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 1'!$D$6:$D$25141=TEXT(C$11,"@"))*" _
"('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 1'!$AS$6:$AS$25141=0)*('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 1'!$AT$6:$AT$25141=$A12)*" _
"'Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 1'!$W$6:$W$25141)+SUMPRODUCT(('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 2'!$D$6:$D$19342=TEXT(C$11,"@"))*" _
"('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 2'!$AW$6:$AW$19342=$A12)*'Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 2'!$R$6:$R$19342)," _
"SUMPRODUCT(('Z:\Пользователь01\VBA Программа\2-ВЫГРУЗКА по месяцам\[2019.xlsx]1'!$I$2:$I$30000=$E$4)*('Z:\Пользователь01\VBA Программа\2-ВЫГРУЗКА по месяцам\[2019.xlsx]1'!$AP$2:$AP$30000=$A12)*" _
"'Z:\Пользователь01\VBA Программа\2-ВЫГРУЗКА по месяцам\[2019.xlsx]1'!$T$2:$T$30000)+SUMPRODUCT(('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 1'!$B$6:$B$25141=$E$4)*" _
"('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 1'!$D$6:$D$25141=TEXT(C$11,"@"))*('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 1'!$AS$6:$AS$25141=0)*" _
"('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 1'!$AT$6:$AT$25141=$A12)*'Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 1'!$W$6:$W$25141)+" _
"SUMPRODUCT(('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 2'!$B$6:$B$19342=$E$4)*('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 2'!$D$6:$D$19342=TEXT(C$11,"@"))*" _
"('Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 2'!$AW$6:$AW$19342=$A12)*'Z:\Пользователь01\VBA Программа\3-ВЫГРУЗКА\[Обработка 2019-2021.xlsm]Прил 2'!$R$6:$R$19342))"

Dim PUTI
Dim GOD
set PUTI=" 'Z:\Пользователь01\VBA Программа\2-ВЫГРУЗКА по месяцам\"
set GOD = Range("A2") & ".xlsx".text

Итого: Range(Cells(2, 68), Cells(l, 68)).FormulaR1C1 = "=IF($E$4="ИНН",SUMPRODUCT((PUTI & GOD & 1'!$AP$2:$AP$30000=........