Sub Del_files()
Dim sFolder, sFile, maska, filename As String
Application.ScreenUpdating = False: Application.DisplayAlerts = False
maska = "20241001" ' здесь (пример) указываем уникальную часть маски
With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub       
        sFolder = .SelectedItems(1)   
 End With    
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)   
sFile = "*" & maska & "*"  'маска файла    
filename = Dir(sFolder & "*") 'получить первое имя файла в каталоге 
   Do While filename <> "" 'цикл по всем файлам в папке    
     If Not filename Like sFile Then ' сравнить имя файла с маской         
        On Error Resume Next         
         Kill sFolder & filename 'удалить файл      
     End If
     filename = Dir 'получить имя следующего файла в папке
 Loop
Application.DisplayAlerts = True: Application.ScreenUpdating = True
End Sub

Sub Del_files()
Dim sFolder, sFile, maska, filename As String
Application.ScreenUpdating = False: Application.DisplayAlerts = False
maska = "20241001" ' здесь указываем уникальную часть маски
With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub       
 sFolder = .SelectedItems(1)   
 End With    
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)   
sFile = "*" & maska & "*"  'маска файла    
filename = Dir(sFolder & "*") 'получить первое имя файла в каталоге 
   Do While filename <> "" 'цикл по всем файлам в папке    
     If Not filename Like sFile Then ' сравнить имя файла с маской         
      On Error Resume Next         
      Kill sFolder & filename 'удалить файл      
      filename = Dir 'получить имя следующего файла в папке   
     End If   
 LoopApplication.DisplayAlerts = True: Application.ScreenUpdating = True
End Sub

Sub Del_files()Dim sFolder, sFile, maska, filename As String
Application.ScreenUpdating = False: Application.DisplayAlerts = False
maska = "20241001" ' здесь указываем уникальную часть маски
With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub       
 sFolder = .SelectedItems(1)   
 End With    
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)   
sFile = "*" & maska & "*"  'маска файла    
filename = Dir(sFolder & "*") 'получить первое имя файла в каталоге 
   Do While filename <> "" 'цикл по всем файлам в папке    
     If filename <> sFile Then ' сравнить имя файла с маской         
      On Error Resume Next         
      Kill sFolder & filename 'удалить файл      
      filename = Dir 'получить имя следующего файла в папке   
     End If   
 LoopApplication.DisplayAlerts = True: Application.ScreenUpdating = True
End Sub

Sub Del_files()
Dim sFolder, sFile, maska, filename As String
Application.ScreenUpdating = False: Application.DisplayAlerts = False
maska = txtRowsCount1.Text ' здесь указываем уникальную часть маски
With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub       
 sFolder = .SelectedItems(1)   
 End With    
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)   
sFile = "*" & maska & "*"  'маска файла    
filename = Dir(sFolder & "*") 'получить первое имя файла в каталоге 
   Do While filename <> "" 'цикл по всем файлам в папке    
     If filename <> sFile Then ' сравнить имя файла с маской         
      On Error Resume Next         
      Kill sFolder & filename 'удалить файл      
      filename = Dir 'получить имя следующего файла в папке   
     End If   
 LoopApplication.DisplayAlerts = True: Application.ScreenUpdating = True
End Sub

Sub DeleteEmptySubfolders()
    Dim FSO, Folder, Subfolder As Object
    Dim FolderPath, UserName As String
    UserName = Environ("USERNAME")
    FolderPath = "C:\Users\UserName\Desktop\ÒÅÑÒ_\"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(FolderPath)

    For Each Subfolder In Folder.SubFolders
        If FSO.GetFolder(Subfolder.path).Files.Count = 0 Then
            Subfolder.Delete
        End If
    Next

    Set FSO = Nothing
    Set Folder = Nothing
    Set Subfolder = Nothing
End Sub

Sub HighlightDuplicates()

Dim rng, cell As Range

Set rng = ActiveWorkbook.Sheets("дубли").Range("A1:A100")

For Each cell In rng.Cells

    If Application.WorksheetFunction.CountIf(rng, cell.Value) > 1 And cell.Value <> "" Then

        cell.Offset(0, 1).Value = "дубль"

    End If

Next cell

End Sub

Sub Edit_all_XML_from_Folder()
    '
    Dim sFolder, sFiles As String
    Dim fso As New FileSystemObject, fl As File, fls As TextStream
    '
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xml")
    Do While sFiles <> ""
        Set fl = fso.GetFile(sFolder & sFiles)
        'действия с файлом
        sFiles = Replace(fl.OpenAsTextStream(ForReading).ReadAll, "<value status=""0"">", "<value>") ' в кавычках указываем то, что меняем и на что меняем
        Set fls = fl.OpenAsTextStream(ForWriting)
        fls.Write sFiles
        fls.Close
        sFiles = Dir
    Loop
    Application.ScreenUpdating = True
    MsgBox "Файлы .xml отредактированы!", , "я проверил)"
    '
End Sub

Sub Replace_in_XML()
Dim TheFolder, TheFiles, AFile
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set TheFolder = fso.GetFolder("C:\Users\Desktop\Каталог\") ' путь к каталогу с xml
Set TheFiles = TheFolder.Files
For Each AFile In TheFiles
ReadXML (AFile)
Next
End Sub
Sub ReadXML(af As String)
Dim xml_doc As New DOMDocument
Dim nde_test As IXMLDOMElement
xml_doc.Load af
For Each nde_test In xml_doc.SelectNodes("<value status=""0"">")
  Debug.Print nde_test.SelectSingleNode("<value>").Text
Next
End Sub

Sub q()
'
'ГОТОВО!превращение в ФОРМУЛу
ThisWorkbook.Sheets("1").Range("AI3").FormulaLocal = "=" & ThisWorkbook.Sheets("1").Range("AI3")

End Sub

Sub q()
     Range("AI3").Formula = "=" & Range("AI3")
End Sub

Sub q()
     ThisWorkbook.Sheets("1").Range("AI3").Formula = "=" & ThisWorkbook.Sheets("1").Range("AI3")
     'ThisWorkbook.Sheets("1").Cells(3, 35).Formula = "=" & ThisWorkbook.Sheets("1").Cells(3, 35)
End Sub

Sub q()
'
' замена на формулу
'
Range("C1").Formula = "=" & Range("C1")
'
End Sub