Option Explicit

Sub test()
Dim wbUR As Workbook
Dim sURAddress As String

Set wbUR = Workbooks.Open("123.xlsx") 'книга в которой ищем UsedRange
wbUR.Windows(1).Visible = False 'скрываем окно книги
wbUR.Worksheets(1).Activate 'активируем нужный лист для определения UsedRange
sURAddress = wbUR.Worksheets(1).UsedRange.Address  'определяем адрес UsedRange
wbUR.Close False ' закрываем книгу

End Sub

Private Sub Workbook_Open()
Dim wrkBoook As Workbook
Dim wrkBook As Workbook
Dim strPath As String, strFile As String
    Application.ScreenUpdating = False
Set wrkBoook = ThisWorkbook
        strPath = wrkBoook.Path  '--- адрес папки где хранится рабочая книга
        strFile = strPath & "\Mat_Elem_trigger.xls"
    Set wrkBook = Application.Workbooks.Open(strFile)
        Call PriceRegion(wrkBook, strPath)
        wrkBook.Close False'--- После срабатывания этой функции все перезаписывается!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
         
        ThisWorkbook.Close True
End Sub
 
Sub PriceRegion(wrkBook As Workbook, strPath As String)
     
    Dim shtOld As Worksheet, shtNew As Worksheet
    Dim rngFirst1 As Range, rngLast1 As Range, rngAll1 As Range
    Dim Nrow As Long, NrowMax As Long
     
    Set shtOld = wrkBook.Worksheets("Price")
    Set shtNew = wrkBook.Worksheets("Progon")
     
    Application.ScreenUpdating = False
     
    Call ClearSheet(shtNew)
     
    Set rngFirst1 = shtOld.Range("A3")
                NrowMax = shtOld.Rows.Count
     
    Do
        Set rngAll1 = rngFirst1.CurrentRegion
                Nrow = rngAll1.Rows.Count
            Call Progon(rngAll1)
            Call ReverceList1(wrkBook, shtOld, shtNew, rngFirst1)
        Set rngLast1 = rngAll1.Cells(Nrow, 1)
        Set rngFirst1 = rngLast1.End(xlDown)
         
    Loop Until rngFirst1.Row = NrowMax
        wrkBook.Save
        shtNew.SaveAs Filename:=strPath & "\price" & Format(Now(), "yyyymmdd_hhnnss") & ".txt", FileFormat:=xlUnicodeText, CreateBackup:=True
End Sub