Makro na kopírování obsahů více jak 100 sešitů

0
0

Dobrý den, mám problém s jedním markem, které mi má překopírovat z více jak 100 sešitů již specifickou oblast, která je již v každém definována. Sešity jsou umístěné v jednom adresářiVyužil jsem tuto funkci:

Sub simpleXlsMerger() Dim bookList As Workbook Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object Application.ScreenUpdating = False Set mergeObj = CreateObject("Scripting.FileSystemObject")

Set dirObj = mergeObj.Getfolder("C:\Users\uzivatel\Documents\Test\") Set filesObj = dirObj.Files For Each everyObj In filesObj Set bookList = Workbooks.Open(everyObj) Selected.Copy ThisWorkbook.Worksheets(1).Activate

'Do not change the following column. It's not the same column as above Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial

Application.CutCopyMode = False bookList.Close Next End Sub

Problém je, že makro pracuje jen částečně a při tak velkém objemu dat začíná pracovat chybně. Potřeboval bych toto makro klidně i tak, aby byly soubory rovnou definovány a načítali se postupně. Moc děkuji za případné nápady

Marked as spam
Odeslal visnak.j@seznam.cz
Otázka položena 22.9.2016 6:26
56 views

Odešlete svou odpověď

Attach YouTube/Vimeo clip putting the URL in brackets: [https://youtu.be/Zkdf3kaso]