Dieesels píše:Dobrý den, jak to upravit (viz.níže), aby se data importovala do aktivního sešitu na určitý list ?Kód: Vybrat vše
Option Explicit
Sub Import()
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 = "E:\excel" ' cesta k souborum
ZdrojAdresa = "a1,b2,c3:d4,f5" ' adresy bunek se zdrojovymi daty
Set CilOblast = ActiveWorkbook.Worksheets("list1").Range("a1")
Application.ScreenUpdating = False
j = 0 ' ofset radku na cilovem listu
Do
If ImportFirstFile Then
ImportFile = Dir(ImportDir & "\*.xls") ' prvni soubor v adresari
If ImportFile = "" Then _
MsgResponse = MsgBox("Adresáø souborù: '" & 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 souborù: '" & ImportDir _
& "' k importu nejsou další soubory!", _
vbOKOnly + vbInformation, MsgTit): Exit Do
'
MsgBox ImportFile ' pouze pro test
'
ListData = "list1" ' 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
j = j + 1 ' dalsi radek na cilovem listu
Loop ' dalsi soubor
Application.ScreenUpdating = True
End Sub
// Vytvořeno samostatné téma.
// Příště to laskavě udělej sám a nevnucuj se do tématu, kde se řešil jiný problém a je již dávno vyřešeno. Díky!
// Mike007
