Tu je kostra, zvyšok si snáď doladíš
Option Explicit
Sub Test()
Dim IsOpen As Boolean, MyArr As Variant, Msg As Byte, MySplit As Variant, wb As Workbook
With Application.FileDialog(msoFileDialogOpen)
.Title = "Prosim, vyberte subor s datami ku kopirovaniu"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
MsgBox "Nebol vybrany ziadny subor, niet co kopirovat"
Exit Sub
Else
Msg = MsgBox("Pre spracovanie vystupu ste zvolili subor " & .SelectedItems(1) & vbNewLine _
& "Chcete vystup spracovat skutocne na zaklade dat z tohoto suboru?", vbYesNo)
If Msg = 7 Then
MsgBox "Nepotvrdili ste vyber suboru, z ktoreho chcete vygenerovat vystup."
Exit Sub
End If
End If
Application.ScreenUpdating = False
MySplit = Split(.SelectedItems(1), "\")
MySplit = MySplit(UBound(MySplit))
For Each wb In Workbooks
If wb.Name = MySplit Then
IsOpen = True
Exit For
End If
Next wb
If IsOpen = False Then
Set wb = Workbooks.Open(.SelectedItems(1))
Else: Set wb = Workbooks(MySplit)
End If
End With
MyArr = wb.Sheets(1).[A9:F108]
If IsOpen = False Then wb.Close
Set wb = Nothing
ThisWorkbook.ActiveSheet.[A9:F108] = MyArr
Erase MyArr
Application.ScreenUpdating = True
End Subcitovat
Option Explicit
Sub Test()
Dim IsOpen As Boolean, MyArr As Variant, Msg As Byte, MySplit As Variant, wb As Workbook
With Application.FileDialog(msoFileDialogOpen)
.Title = "Prosim, vyberte subor s datami ku kopirovaniu"
.Show
.AllowMultiSelect = False
If .SelectedItems.Count = 0 Then
MsgBox "Nebol vybrany ziadny subor, niet co kopirovat"
Exit Sub
Else
Msg = MsgBox("Pre spracovanie vystupu ste zvolili subor " & .SelectedItems(1) & vbNewLine _
& "Chcete vystup spracovat skutocne na zaklade dat z tohoto suboru?", vbYesNo)
If Msg = 7 Then
MsgBox "Nepotvrdili ste vyber suboru, z ktoreho chcete vygenerovat vystup."
Exit Sub
End If
End If
Application.ScreenUpdating = False
MySplit = Split(.SelectedItems(1), "\")
MySplit = MySplit(UBound(MySplit))
For Each wb In Workbooks
If wb.Name = MySplit Then
IsOpen = True
Exit For
End If
Next wb
If IsOpen = False Then
Set wb = Workbooks.Open(.SelectedItems(1))
Else: Set wb = Workbooks(MySplit)
End If
End With
MyArr = wb.Sheets(1).[A9:F108]
If IsOpen = False Then wb.Close
Set wb = Nothing
ThisWorkbook.ActiveSheet.[A9:F108] = MyArr
Erase MyArr
Application.ScreenUpdating = True
End Subcitovat