Sub Frankenstein()
'в столбец(1) выводит имена файлов из конкрет паки начинающихся на "4443_"
'потом сортируется не самым красивым способом
'из А1 берется то заветное имя_файла а дальше открывается/копируется/закрывается
    Dim sFolder As String, sFiles As String
         
sFolder = "C:\"
'путь менять   
     sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
     'я не понимаю как эта строка работает но решил оставить
     
     sFiles = Dir(sFolder & "4443_2018*.xls*")
     'начало у "моих" файлов одинаковое

   Worksheets(1).Select

    Do While sFiles <> ""
            Range("A1").Select
            Range("A1").Value = "4443_00000000_000000"
            'нельзя чтоб а1 была пустой :(
            
           '  MsgBox sFiles

        If Worksheets(1).Range("A1").Offset(1, 0) <> "" Then
            Worksheets(1).Range("A1").End(xlDown).Select
        End If
        
           ActiveCell.Offset(1, 0).Select
            ActiveCell.Value = sFiles
            sFiles = Dir
    Loop

    i = Worksheets(1).Range("A1").End(xlDown).Row

    'чтобы найти самый новый файл пришлось извращатся и сортировать имена в ячейках иксель
    'хотел бы я знать как сделать по другому
    'вся последующая сортировка скопирована из "запись макроса" менял только диапазон с помощью i

        ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
        ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range("A6"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(1).Sort
        .SetRange Range(Cells(1, 1), Cells(i, 1))
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
   ' когда получчил имя файла наконец его открываю
   ' копирую единственный лист из файла , вставляю его ,
   ' закрываю документ без сохр, подтираю первый столбец

    Sheets(1).Select
    PathName = "C:\Users\admin\Downloads"
    Filename = Range("A1").Value
    TabName = "лист_будет_обработан_иудален"
    ControlFile = ActiveWorkbook.Name
    Workbooks.Open PathName & "\" & Filename
    ActiveSheet.Name = TabName
    Sheets(TabName).Copy After:=Workbooks(ControlFile).Sheets(1)
    Windows(Filename).Activate
    ActiveWorkbook.Close SaveChanges:=False
    Windows(ControlFile).Activate
    Sheets(1).Columns(1).Delete
End Sub