PC-HELP.CZ

Sub Import_2()
Dim MsgResponse, MsgTit As String
Dim ImportFirstFile As Boolean, ImportDir As String, ImportFile As String
Dim ZdrojSoubor As Workbook, ZdrojList As Worksheet, ListData As String, ZdrojAdresa As String
Dim ZdrojOblast As Range, c As Range
Dim CilOblast As Range, i As Integer, j As Integer
MsgTit = "Import dat"
ImportFirstFile = True ' identifikace prvniho souboru v adresari
ImportDir = "\\192.168.2.244\zlutysanon_vaclavak\Zaměstnanci - seznam" ' cesta k souborum
ZdrojAdresa = "A5,c13,d15,a17,a19,a21,a23,a25,a27,a33,a35,a39,a41" ' adresy bunek se zdrojovymi daty
Set CilOblast = ActiveWorkbook.Worksheets("seznam").Range("a2")
Application.ScreenUpdating = False
j = 0 ' ofset radku na cilovem listu
Do
If ImportFirstFile Then
ImportFile = Dir(ImportDir & "\*.xlsm") ' prvni soubor v adresari
If ImportFile = "" Then _
MsgResponse = MsgBox("Adresář souboru: '" & ImportDir _
& "' k importu je prázdný!", _
vbOKOnly + vbInformation, MsgTit): Exit Do
ImportFirstFile = False
Else
ImportFile = Dir ' dalsi soubory v adresari
End If
If ImportFile = "" Then _
MsgResponse = MsgBox("V adresáři souboru: '" & ImportDir _
& "' k importu nejsou další soubory!", _
vbOKOnly + vbInformation, MsgTit): Exit Do
'
'
ListData = "Zakladaci karta" ' algoritmus prirazeni nazvu zdrojoveho listu dle souboru???
'
Set ZdrojSoubor = Workbooks.Open(ImportDir & "\" & ImportFile) ' otevrit soubor
Set ZdrojList = ZdrojSoubor.Worksheets(ListData)
Set ZdrojOblast = ZdrojList.Range(ZdrojAdresa)
i = 0 ' ofset sloupcu na cilovem listu
For Each c In ZdrojOblast.Cells
CilOblast.Offset(j, i).Value = c.Value
i = i + 1 ' dalsi sloupec na cilovem listu
Next c
ZdrojSoubor.Close True
j = j + 1 ' dalsi radek na cilovem listu
Loop ' dalsi soubor
Range("A1:m85").Select
ActiveWorkbook.Worksheets("seznam").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("seznam").Sort.SortFields.Add Key:=Range("A2:A85") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("seznam").Sort
.SetRange Range("A1:m85")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub

Prosím tohle se mi ukazuje a ja nevim proc to najednou nefunguje poradite nekdo ?

Dekuji Kment

IP platná ?
Cesta platná ?
Win ste nemenil ?
Účet z ktorého sa pripájate má povolený prístup do zložky ? (mohli ste sa prelogovať na iné konto, zmeniť konto, na servery mohol byť zásah,...)
Ak dáte cestu na skúšku na lokálnom PC, ide to OK ?
Ak dáte cestu na skúšku na iné sieťové miesto (iný PC), ide to ?