Excel - makro

Sub LoadData()
    Dim aRange As Range
    Dim aIndex As Integer
    Dim aOpened As Boolean
    Dim aFilename As String
    Dim aWorkbook As Workbook
    
    Set aRange = Range("C3:E5")
    For aIndex = 1 To aRange.Rows.Count
        aFilename = "Vzorek " & aIndex & ".xlsx"
        On Error Resume Next
        Set aWorkbook = Workbooks(aFilename)
        On Error GoTo 0
        If aWorkbook Is Nothing Then
            Set aWorkbook = Workbooks.Open(ThisWorkbook.Path & "\" & aFilename)
            aOpened = True
        End If
        aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Povrch").Range("B5")
        aRange.Cells(aIndex, 2).Value = aWorkbook.Worksheets("Objem").Range("C5")
        aRange.Cells(aIndex, 3).Value = aWorkbook.Worksheets("Poloměr").Range("D5")
        If aOpened Then
            aWorkbook.Close False
            aOpened = False
        End If
        Set aWorkbook = Nothing
    Next aIndex
End Sub

Lose, moc děkuju, funguje to - neuvěřitelné!

Mě ještě napadlo...v případě, že by se ve složce kromě výše zmíněných souborů Vzorek 1-3.xlsx nacházely třeba soubory A.xlsx nebo Materiál.xlsx - dal by se ten kod ještě nějak vylepšit, aby to tahalo i data z nich?? V podstatě by stačilo, aby to tahalo data ze všech xlsx souborů ve složce (samozřejmě krom toho MASTERu). Umístění kopírovaných buňěk v těchto sešitech samozřejmě zůstává stejné.

Aby sa názvy súborov brali podľa stĺpca Vzorek, tak stači upraviť riadok:

aFilename = "Vzorek " & aIndex & ".xlsx"

na:

aFilename = aRange.Cells(aIndex, 0).Value & ".xlsx"

To mi právě nefunguje - zbytek opravdu zůstane stejný včetně:

aRange.Cells(aIndex, 1).Value = aWorkbook.Worksheets("Povrch").Range("B5")
        aRange.Cells(aIndex, 2).Value = aWorkbook.Worksheets("Objem").Range("C5")
        aRange.Cells(aIndex, 3).Value = aWorkbook.Worksheets("Poloměr").Range("D5")

??
Bavíme se o načítání všech xlsx souborů ze složky bez rozdílu názvu?

To, čo som napísal, by malo fungovať vtedy, keď do stĺpca Vzorek vypíšeš ručne názvy tých súborov, z ktorých chceš načítať hodnoty.

Ak chceš načítavať hodnoty podľa súborov, ktoré sú v adresári, tak použi funkciu Dir.

Ďalšie problémy, ktoré budeš musieť riešiť, sú:
- vyčistenie oblasti po predchádzajúcom načítaní dát,
- úprava formátovania buniek (ak ti na tom záleží).

Ak to potrebuješ len jednorazovo, tak výpis všetkých *.xlsx súborov dostaneš jednoducho pomocou príkazového riadku:

dir *.xlsx /B

Díky moc za radu, lose. Ale vidím to tak, že než to komplikovat, tak všem souborům přiřadím stejný název (s rostoucí proměnnou, tzn. Vzorek 1-100) a bude prostě fungovat to Tvé mrvní makro.

Ještě jednou díky.

Dobrý den,
já bych potřeboval obdobné makro, s tím rozdílem že by vyhledávalo určité xlsx soubory v různých adresářích a obsah listu každého z nich by překopírovalo do nového souboru na jeden list pod sebe (hlavičky a sloupce jsou stejné, pouze se mění data a počty řádků).
Př. vybrat data ze souborů beh* v adresářích
c:\kurzy\20140201\beh1.xlsx
c:\kurzy\20140202\beh2.xlsx
c:\kurzy\20140203\beh3.xlsx a vložit do nového souboru c:\kurzy\2014_02\prehled.xlsx

Ještě jedna věc - V každém ze svých cca 70ti sešitů je v buňce A47 umístěn text (pokaždé jiný). Poradí někdo, jak vytvořit makro, aby se tímto textem pojmenoval název sešitu a nemusel jsem to po jednom přejmenovávat?

Děkuji.

Umiestni tento VBS skript do adresára a spusti:

Set app = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")

path = fso.GetAbsolutePathName(".")
Set folder = fso.GetFolder(path)
For Each file In folder.Files
    If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then
        Set wb = app.Workbooks.Open(path & "/" & file.Name)
        name = wb.Worksheets(1).Range("A47").Value
        wb.Close
        Set wb = Nothing
        If file.Name <> name & ".xlsx" Then
            file.Name = name & ".xlsx"
        End If
    End If
Next
app.Quit

Set app = Nothing
Set fso = Nothing

lose, nějak mi to nefunguje pro xlsm soubory (i přesto, že jsem přepsal xlsx na xlsm). Není to tím, že název listu ve které se nachází řečená buňka je PXD?

Neviem, čím to je, ale názov listu stačí predsa doplniť do tohoto riadku:

name = wb.Worksheets("PXD").Range("A47").Value