MS Excel

Pravda mohl jsem to více upřesnit, hledat jsem zkoušel ale našel jsem jen to co mám a když sem našel něco takovedlého tak mi to nefungovalo, mě by to právě vyhovovalo tak jak jsem psal že si označím všechny sešity z kterych chci kopirovat a hodí mi to do jednoho listu. Tak jak jsi to makro udělal v tom vlakně jak píšu víš.

Stačil by mi obsah od A1 po T50, tam se ty data vyskytujou (a a je tam i rezerva) ukazku tu u sebe ted bohuzel nemam, jinak bych dal ale jedna se o tabulku s textem stačil by mi tedy jen ten obsah A1 po T50 nic víc bych kopirovat nepotřeboval žadné zahlaví nic.citovat

Dik za tip s LastCell, prestal jsem ho kdysi uplne pouzivat, nebot se to nechovalo regulerne, pamatovalo si to posledni bunku treba na radku 1000 a i kdyz se tam pak vymazaly radky, porad to vracelo ten puvodni nesmysl a neslo to spolehlive resetovat ani rucne ani kodem. Ale pro ucely kopirovani nezname oblasti to je idealni.

K samotnemu kodu: nezabyval jsem se odolnosti vuci stavum, kdy kopirovany sesit anebo list je zamceny, schovany nebo obsahuje dalsi zrady.
Sub Kopiruj()

Dim wb As Workbook, wbX As Workbook
Dim ws As Worksheet, wsx As Worksheet
Dim i As Integer, j As Integer, iMxRow As Long, iLastR As Long, iLastC As Long, k As Integer

'zkratka pro tento sesit
Set wb = ThisWorkbook
Set ws = ActiveSheet

' Otevri dialog
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = ""
.AllowMultiSelect = True
.Filters.Add "Excel", "*.xls"
.Show

Application.DisplayAlerts = False
Application.ScreenUpdating = False

' pro kazdy vybrany soubor
On Error GoTo errHandler
For i = 1 To .SelectedItems.Count

Workbooks.Open .SelectedItems(i)
Set wbX = ActiveWorkbook
'nakopiruj listy do wb
For j = 1 To wbX.Sheets.Count
Set wsx = wbX.Worksheets(j)
'posledni radek a sloupec oblasti ke kopirovani
iLastR = wsx.Cells.SpecialCells(xlCellTypeLastCell).Row
iLastC = wsx.Cells.SpecialCells(xlCellTypeLastCell).Column

'novy radek na cilovem liste: zkoumej A,B C sloupce
iMxRow = Application.Max(ws.Range("A65000").End(xlUp).Row, ws.Range("B65000").End(xlUp).Row, ws.Range("C65000").End(xlUp).Row)
If iMxRow > 1 Then iMxRow = iMxRow + 2 'at je mezi daty jeden prazdny radek
k = k + 1

wsx.Activate

' 'pokud kopirovat uplne vse tak takhle:
Range(Cells(1, 1), Cells(iLastR, iLastC)).Copy (ws.Cells(iMxRow, 1))
' ws.Cells(iMxRow - 1, 1) = "Ze souboru: " & wbX.Name & " List: " & wsx.Name & " " & k
' 'pokud kopirovat jenom hodnoty a treba formaty tak tahkle:
' Range(Cells(1, 1), Cells(iLastR, iLastC)).Copy
' ws.Activate
' Cells(iMxRow, 1).PasteSpecial Paste:=xlPasteValues
' Cells(iMxRow, 1).PasteSpecial Paste:=xlPasteFormats
Next j
wbX.Close (0)
Next i

End With

MsgBox "Zkopirovany oblasti z " & k & " listu"
GoTo fiNito

errHandler:
MsgBox "Zkopirovano pouze " & k & " listu" & vbCr & _
"Pri kopirovani listu " & wsx.Name & "ze souboru " & wbX & " doslo k chybe"

fiNito:
With Application
.CutCopyMode = xlCut
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Subcitovat

Díky moc všem za pomoc a makra,

Milan-D - zkoušel jsem to makro ale bohužel mi to nefunguje, nevím proč vyberu listy dam ok a chvili to něco dělá napíše že je načteno tolik a tolik listu dam ok. Ale nikde se nic neobjeví, žadné importované listy nikde. zkoušel jsem s tim trochu laborovat ale marná snaha. ( zkoušel sem i ten druhy import co tam maš v poznamkach a taky nic) bude to asi nějaká blbost.

marjankaj - tvé makro jsem taky zkoušel ale to se asi musí upravit jinak mi to hazi error na což ja nejsem odborník.citovat

Neskodilo by, kdyby ses vyjadril presne. Ten muj kod nemuze hlasit kolik listu je nacteno. Pokud to neco hlasi, tak to je pocet zkopirovanych listu a v tom stadiu by opravdu mely byt zkopirovane.
Nezbyva nez abys provedl zakladni troubleshooting. Zaremuj (na zacatek radku vloz apostrof) prikaz Application.ScreenUpdating = True.
Nasad zarazku (F9) na kopirovaci radek Range(Cells(1, 1), Cells(iLastR, iLastC)).Copy (ws.Cells(iMxRow, 1)) a spust makro (F5). Procedura se zastavi na zarazce, radek zustane zluty.
Zkontroluju hodnoty vsech promennych, jestli zodpovidaji skutenosti. Dal uz krokuj F8. Hned po prvnim kroku se musi prvni list vybraneho souboru nakopirovat. Jestli ne, napis mi hodnoty vesch promennych - uvidis je v Locals Window, ktere zobrazis pres VBA menu View(Zobrazit) - Locals Windows). Snaz se premyslet, co by mohlo byt spatne. Jestli ten kopirovany list (v tomto okamziku bude zrovna aktivni) opravdu nejaka data obsahuje, na kterem radku ta obast dat konci, jestli tomu odpovida hodnota promenne iLastR atd... Chces-li makra pouzivat, musis taky vynalozit usili. Jinak budes odsouzen na excelovou zebrotu. A jeste neco: az zjistis kde byl problem, tak nam to taky rekni, ne jak vetsina tazatelu, kteri bud nenapisou nic, anebo jen...tak uz to funguje citovat

No keby si ty priložil súbor, tak by to už asi bolo vyriešené.citovat