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
Prestalo mi to fungovat pri zmene exelu na verzi 2016
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Prestalo mi to fungovat pri zmene exelu na verzi 2016
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 ?
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 ?
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
Přestalo fungovat kliknutí na touchpadu (L+R)
od Micmen » 21 led 2024 20:58 » v Problémy s hardwarem - 0
- 472
-
od Micmen
Zobrazit poslední příspěvek
21 led 2024 20:58
-
-
- 24
- 3984
-
od JanC
Zobrazit poslední příspěvek
08 lis 2023 08:19
-
-
Problém s připojením na wifi síť při změně PC Příloha(y)
od Baader » 09 srp 2023 10:38 » v Sítě - hardware - 18
- 3028
-
od Baader
Zobrazit poslední příspěvek
10 srp 2023 14:16
-
-
- 2
- 1124
-
od Venus
Zobrazit poslední příspěvek
13 úno 2024 16:57
-
- 4
- 586
-
od Minapark
Zobrazit poslední příspěvek
28 úno 2024 20:30
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti