Sub SelectFileAndCopy()

Dim MyFile As String
Dim iWb As Workbook
 
 Application.ScreenUpdating = False
 Application.EnableEvents = False
On Error Resume Next
 'Select file(s) in Mac Excel, you are only able to select the file format that you want,
 'with this custom GetOpenFilename function, the built-infunction is not working correct on the Mac
 'Ron de Bruin, 9-Dec-2024. For more info visit the webpage below
 'https://macexcel.com/examples/filesandfolders/selectfiles/
 
'The first argument is the Folder that opens by default, If the second argument is False you be able to select more than one file, If True only one file, the third argument is the file filter
'In this example you are only be able to select xls, xlsx and xlsm files, other examples you can find on my webpage
MyFile = GetOpenFileNameMac(ThisWorkbook.Path, False, _
                "{""com.microsoft.Excel.xls"",""org.openxmlformats.spreadsheetml.sheet"",""org.openxmlformats.spreadsheetml.sheet.macroenabled""}")

If bIsBookOpen(MyFile) = False Then
  Set iWb = Workbooks.Open(MyFile)
ElseIf MsgBox("Файл " & MyFile & " уже открыт. Продолжить работу с ним?", vbQuestion + vbYesNo, "Внимание!") = vbNo Then
  Exit Sub
End If

If MsgBox("Загрузить данные на лист Газа?", vbQuestion + vbYesNo, "Загрузка данных") = vbNo Then Exit Sub

With ThisWorkbook.Worksheets("Газа")
  .Range("A2:H10000").Cells.Clear
  iWb.Worksheets("Лист_1").Range("A13:H4000").Copy .Range("A2")
End With
 Application.EnableEvents = True
 Application.ScreenUpdating = True
End Sub

Function GetOpenFileNameMac(StartFolder As String, OneFile As Boolean, FileFilter As String) As String
 'Select file(s) in Mac Excel, you are only able to select the file format that you want,
 'Ron de Bruin, 9-Dec-2024. For more info visit the webpage below
 'https://macexcel.com/examples/filesandfolders/selectfiles/
 On Error Resume Next
  If OneFile = True Then
   MyScript = _
           "set theFile to (choose file of type" & _
           " " & FileFilter & " " & _
           "with prompt ""Please select a file"" default location alias POSIX file (""" & _
           StartFolder & """) " & "without multiple selections allowed) as string" & vbNewLine & _
           "return posix path of theFile"
   Else
       MyScript = _
           "set theFiles to (choose file of type" & _
           " " & FileFilter & " " & _
           "with prompt ""Please select a file or files"" default location alias POSIX file (""" & _
           StartFolder & """) " & "with multiple selections allowed)" & vbNewLine & _
           "set thePOSIXFiles to {}" & vbNewLine & _
           "repeat with aFile in theFiles" & vbNewLine & _
           "set end of thePOSIXFiles to POSIX path of aFile" & vbNewLine & _
           "end repeat" & vbNewLine & _
           "set {TID, text item delimiters} to {text item delimiters, ASCII character 10}" & vbNewLine & _
           "set thePOSIXFiles to thePOSIXFiles as text" & vbNewLine & _
           "set text item delimiters to TID" & vbNewLine & _
           "return thePOSIXFiles"
   End If
GetOpenFileNameMac = MacScript(MyScript)
On Error GoTo 0
End Function

Function bIsBookOpen(ByRef szBookName As String) As Boolean
  On Error Resume Next
  bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Sub ShowGetOpenDialod()
    Dim avFiles
    Dim wb As Workbook
    'по умолчанию к выбору доступны файлы Excel(xls,xlsx,xlsm,xlsb)
    avFiles = Application.GetOpenFilename _
                ("Excel files(*.xls*),*.xls*", 1, "Выбрать Excel файлы", , False)
    If VarType(avFiles) = vbBoolean Then Exit Sub
    Set wb = Workbooks.Open(avFiles)
    Call Copy1(wb)
    wb.Close False
    MsgBox "Данные успешно скопированы!"
End Sub
 
Private Sub Copy1(iWb As Workbook)
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range
 
    If MsgBox("Загрузить данные на лист Газа?", vbQuestion + vbYesNo, "Загрузка данных") = vbNo Then Exit Sub
     
 
    ' “кажите путь к исходной книге
    Set sourceWorkbook = iWb  'Workbooks.Open("/Users/alex/Yandex.Disk.localized/„лЯ отчетов/ЂЉЃ џдро XLS.xls")
    Set targetWorkbook = ThisWorkbook ' –елеваЯ книга - это книга, в которой находитсЯ макрос
    Set sourceSheet = sourceWorkbook.Sheets("Лист_1") ' “кажите имЯ листа в исходной книге
    Set targetSheet = targetWorkbook.Sheets("Газа") ' “кажите имЯ листа в целевой книге
 
    'очищаем данные на листе Ѓаза
    targetSheet.Range("A2:H10000").Cells.Clear
    ' “кажите диапазон длЯ копированиЯ
    Set sourceRange = sourceSheet.Range("A13:H4000") ' €змените диапазон по мере необходимости
    Set targetRange = targetSheet.Range("A2") ' ЌачальнаЯ Ячейка длЯ вставки данных
 
    ' Љопирование и вставка данных
    sourceRange.Copy targetRange
 
End Sub

Sub Select_File_Or_Files_Mac()
            Dim MyPath As String
            Dim MyScript As String
            Dim MyFiles As String
            Dim MySplit As Variant
            Dim N As Long
            Dim Fname As String
            Dim mybook As Workbook
        
            On Error Resume Next
            MyPath = MacScript("return (path to documents folder) as String")
            'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"
        
            ' In the following statement, change true to false in the line "multiple
            ' selections allowed true" if you do not want to be able to select more
            ' than one file. Additionally, if you want to filter for multiple files, change
            ' {""com.microsoft.Excel.xls""} to
            ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
            ' if you want to filter on xls and csv files, for example.
            MyScript = _
            "set applescript's text item delimiters to "","" " & vbNewLine & _
                       "set theFiles to (choose file of type " & _
                     " {""com.microsoft.Excel.xls""} " & _
                       "with prompt ""Please select a file or files"" default location alias """ & _
                       MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
                       "set applescript's text item delimiters to """" " & vbNewLine & _
                       "return theFiles"
        
            MyFiles = MacScript(MyScript)
            On Error GoTo 0
        
            If MyFiles <> "" Then
                With Application
                    .ScreenUpdating = False
                    .EnableEvents = False
                End With
        
                MySplit = Split(MyFiles, ",")
                For N = LBound(MySplit) To UBound(MySplit)
        
                    ' Get the file name only and test to see if it is open.
                    Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1))
                    If bIsBookOpen(Fname) = False Then
        
                        Set mybook = Nothing
                        On Error Resume Next
                        Set mybook = Workbooks.Open(MySplit(N))
                        Call Copy1(mybook)
                        On Error GoTo 0
        
                        If Not mybook Is Nothing Then
                            MsgBox "You open this file : " & MySplit(N) & vbNewLine & _
                                   "And after you press OK it will be closed" & vbNewLine & _
                                   "without saving, replace this line with your own code."
                            mybook.Close SaveChanges:=False
                        End If
                    Else
                        MsgBox "We skipped this file : " & MySplit(N) & " because it Is already open."
                    End If
                Next N
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
            End If
        End Sub
        
        Function bIsBookOpen(ByRef szBookName As String) As Boolean
        ' Contributed by Rob Bovey
            On Error Resume Next
            bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
        End Function

Private Sub Copy1(iWb As Workbook)
    Dim sourceWorkbook As Workbook
    Dim targetWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim targetRange As Range

    If MsgBox("Загрузить данные на лист Газа?", vbQuestion + vbYesNo, "Загрузка данных") = vbNo Then Exit Sub
    
    'очищаем данные на листе Ѓаза
    Worksheets("Газа").Range("A2:H10000").Cells.Clear

    ' “кажите путь к исходной книге
    Set sourceWorkbook = iWb  'Workbooks.Open("/Users/alex/Yandex.Disk.localized/„лЯ отчетов/ЂЉЃ џдро XLS.xls")
    Set targetWorkbook = ThisWorkbook ' –елеваЯ книга - это книга, в которой находитсЯ макрос
    Set sourceSheet = sourceWorkbook.Sheets("Лист_1") ' “кажите имЯ листа в исходной книге
    Set targetSheet = targetWorkbook.Sheets("Газа") ' “кажите имЯ листа в целевой книге

    ' “кажите диапазон длЯ копированиЯ
    Set sourceRange = sourceSheet.Range("A13:H4000") ' €змените диапазон по мере необходимости
    Set targetRange = targetSheet.Range("A2") ' ЌачальнаЯ Ячейка длЯ вставки данных

    ' Љопирование и вставка данных
    sourceRange.Copy targetRange

    ' ‡акрытие исходной книги
    sourceWorkbook.Close False

    MsgBox "Данные успешно скопированы!"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("F8")) Is Nothing And Target.Count = 1 Then
    Dim arr(), arrSemi()
    Dim I&, J&, N&
    arr = Me.ListObjects(1).Range.Value
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For I = LBound(arr, 1) To UBound(arr, 1)
      If arr(I, 1) = Target.Value Then
        For J = LBound(arr, 2) To UBound(arr, 2)
          If arr(I, J) = "+" Then
            ReDim Preserve arrSemi(N)
            arrSemi(N) = arr(1, J)
            N = N + 1
          End If
        Next
      End If
    Next
    With Me.Range("G8").Validation
      .Delete
      .Add xlValidateList, Formula1:=Join(arrSemi, ",")
    End With
    Me.Range("G8") = arrSemi(0)
  End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub