Sub Filter_Quarter4()
    Dim lo As ListObject
    Dim iCol As Long
    Set lo = Лист3.ListObjects(1)
    iCol = lo.ListColumns("Дата").Index
    lo.AutoFilter.ShowAllData
        With lo.Range
         .AutoFilter Field:=iCol, _
            Operator:=xlFilterDynamic, _
            Criteria1:=xlFilterAllDatesInPeriodQuarter4
        End With
 End Sub

******************
If Dir(N_S) <> "" Then
GoTo met
 Else
MsgBox "Файл по пути " & N_S & " не найден"
 Exit Sub
End If
met:
If Dir(N_Bes) <> "" Then
GoTo met_
 Else
MsgBox "Файл по пути " & N_Bes & " не найден"
 Exit Sub
End If
met_:
******************

Sub ProcessFiles()
Dim Filename, Pathname, saveFileName As String
Dim wb As Workbook
Dim initialDisplayAlerts As Boolean

Pathname = "C:\Users\MiniPC10\Desktop\Сергей\xlsx_test\"
Filename = Dir(Pathname & "*.xlsx")
initialDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
Do While Filename <> ""
    Set wb = Workbooks.Open(Filename:=Pathname & Filename, _
                            UpdateLinks:=False)
    wb.CheckCompatibility = False
    saveFileName = Replace(Filename, ".xlsx", ".xls")
    wb.SaveAs Filename:=Pathname & saveFileName, _
              FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
              ReadOnlyRecommended:=False, CreateBackup:=False

    wb.Close SaveChanges:=False
    Filename = Dir()
Loop
Application.DisplayAlerts = True
Application.DisplayAlerts = initialDisplayAlerts
End Sub

Sub test_carp_()
s = "*********** / 70g / *****************/ 965115040"
Dim MyRange As Range
Dim MyCell As Range
Set MyRange = Range("D34:D" & Cells(Rows.Count, 1).End(xlUp).Row)
For Each MyCell In MyRange
 If MyCell.Value <> "" Then
 '    Right(s, Len(s) - InStrRev(s, "/") - 1)
  Debug.Print MyCell
 End If
Next MyCell
End Sub

Sub AutoFill_()
    Cells.Replace What:="*/ ", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Range("R34:T34").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "General"
    Range("R34:T34").Select
    ActiveCell.FormulaR1C1 = "=RC[-14]"
    Range("R34:T34").Select
    Selection.AutoFill Destination:=Range("R34:T43"), Type:=xlFillDefault
    Range("R34:T43").Select
End Sub

Sub RunOnTime()
    Application.OnTime TimeValue("12:05:30"), "Розница_склады"
    Application.OnTime TimeValue("15:05:30"), "Розница_склады"
    Application.OnTime TimeValue("18:05:30"), "Розница_склады"
End Sub
Sub Розница_склады()
    Application.ScreenUpdating = False
    Workbooks.Open Filename:="C:\для Excel из 1С\Остатки розн. магазины (XLS).xls"
    Rows("1").Delete
    Cells(1, 1) = "Номенклатура"
    Cells(1, 2) = "Л-30"
    Cells(1, 3) = "С-63"
    Cells(1, 4) = "Дан-8/25"
    ActiveSheet.ListObjects.Add(xlSrcRange, Cells(1, 1).CurrentRegion, , xlYes).Name = _
        "Таблица1"
    ActiveSheet.ListObjects("Таблица1").TableStyle = "TableStyleMedium13"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Ирина\YandexDisk\ххххххххххххххххххххххх.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        ActiveWindow.Close
    Application.ScreenUpdating = True
End Sub

Sub Остатки_магазинов()
Dim r As Date
r = Format(Now(), "dd mmmm yyyy")
    Application.ScreenUpdating = False
    Workbooks.Open Filename:="C:\для Excel из 1С\Остатки_магазинов (XLS).xls"
    Rows("1").Insert
    Cells(1, 2).Value = r
    Rows("6:6").Select
    ActiveWindow.FreezePanes = True
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\Ирина\YandexDisk\Остатки магазинов\Остатки_магазинов.xls", FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        ActiveWindow.Close
    Application.ScreenUpdating = True
End Sub
Sub Запуск()
Application.OnTime TimeValue("11:30:00"), "Остатки_магазинов"
End Sub

Sub test2()
    Dim a As Long
    a = Cells(1, 1).CurrentRegion.Rows.Count
    Cells.MergeCells = False
    Range("B:E, H:H").Delete
    Rows("1:9").Delete
    ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(a, 3)), , xlNo).Name _
= "ТоварныйЧек1"
    Cells(1, 1) = "Номенклатура"
    Cells(1, 2) = "Кол-во закупок"
    Cells(1, 3) = "Сумма закупок"
    ActiveSheet.ListObjects("ТоварныйЧек1").TableStyle = "TableStyleMedium13"
    ActiveSheet.ListObjects("ТоварныйЧек1").ShowTotals = True
End Sub

Sub Макрос1()
    Columns("B:E").Select
    Range("B2").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("A:A").EntireColumn.AutoFit
    Rows("1:6").Select
    Selection.Delete Shift:=xlUp
    Columns("G:M").Select
    Range("G2").Activate
    Selection.Delete Shift:=xlToLeft
End Sub