MS Excel

Chtěl bych vědět , jak udělat načtení z několika sešitů cca 40 do 1 centrálního , každý externí xls sešit na svůj list , aniž by pak zůstaly ty externí sešity otevřeny , prostě bych chtěl v centrálním sešitu , aby se mi vytvořilo 40 listů , které budou obsahovat to co každý z těch jednolistových sešitů.

Zaslat odpověď >

admin(7.4.2009 18:50)#000465

V tomto příkladu se názvy listů v celkovém souboru musí jmenovat stejně jako importované soubory.

Sub copy_data_from_files()
'Zkopírování dat ze souborů

Dim soubory, soubor, nazev_souboru, tento_soubor As String
Dim i As Variant

Application.ScreenUpdating = False
soubory = Array("soubor01", "soubor02", "soubor03", ... )

tento_soubor = ThisWorkbook.Name

For Each i In soubory

soubor = i
nazev_souboru = ThisWorkbook.Path + "\" & soubor

Set wb = Workbooks.Open(Filename:=nazev_souboru)
Cells.Select
Selection.Copy

Windows(tento_soubor).Activate
sheets(soubor).Select
ActiveSheet.Paste
Range("A1").Select

Windows(soubor).Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False

Next

Windows(tento_soubor).Activate
Application.ScreenUpdating = True

End Sub
citovat

bach1(8.4.2009 9:42)#000469

tohle je makro? to by se dalo dát pod nějaké tlačítko načtení dat že? kdyby se mi ty soubory ale jmenovaly jako třeba zlin.xls , praha.xls , brno.xls , luhacovice.xls atd... pak listy by měly shodné názvy s těmito soubory nebo stačí aby se jmenovaly jen zlin , praha atd... a jak by vypadal ten celý zápis toho makra , jsem v tomhle laik , ale tohle by mi zjednodušilo život , nyní to dělám tak , že si otevřu 40 sešitů a do cílového to provážu a pak uložím prostor xlw a otevírám tento prostor a tím se mi otevře všech 40 sešitů , což sice funguje , ale je to docela zvrhlé....citovat

admin(8.4.2009 14:12)#000470

Ano, tohle je makro. Dělám to samé co vy. Těch souborů mám 30. Makro lze spustit "Nástroje/Makro/Makra" (Alt + F8) nebo lze makro vyvolat tlačítkem. O tomto způsobu jsem již psal v článcích.citovat

bach1(8.4.2009 14:43)#000471

prosím ještě o nakopnutí s tímto příkladem:

kdyby se mi ty soubory jmenovaly třeba zlin.xls , praha.xls , brno.xls , luhacovice.xls atd... pak listy v tom vyhodnocovacím listu by měly shodné názvy s těmito soubory ??? nebo stačí aby se jmenovaly jen zlin , praha , brno atd...?? , nebo by se nějak dalo zabezpečit aby se ty listy samy vytvářely a plnily těmi dílčími xls soubory ? A moc prosím jak by vypadal ten celý zápis makra v tomto příkladu?, jsem v tomhle laik.
Děkuji zdvořile za odpověď a pomoc.citovat

Marian(12.4.2009 11:16)#000479

Tak jsem aplikoval to makro , ale je problém , pokud v těch listech nestojí kurzor na A1 , tak to zhavaruje .
Jak to makro doplnit , aby se kurzor vždy nastavil na buňku A1 a teprve pak provedl načtení listu ?citovat

admin(12.4.2009 18:01)#000480

Stačí zadat Range("A1").Selectcitovat

termitus(23.7.2009 11:57)#000596

prosim o radu jeste k tomuto prikladu!
mam stejny pozadavek, jako uvedl bach1

ale nemohu bohuzel rozchodit makro, ktere zaslal Petr.

v Microsoft Visual Basicu, v makrech, vytvorim pro konkretni sesit makro a do nej vlozim, zde jiz napsany kod.
zde upravuji pouze:
soubory = Array("soubor01", "soubor02", "soubor03", ... )
kde vypisuji nazvy souboru (bez .xls) na misto "soubor01", "soubor02" atd.
v em pripade je to (pro zkousku):
soubory = Array("sesit1", "sesit2")
a makro mam v sesitu s nazvem: slouceni.xls, ve kterem mam 2 zalozky s nazvy: sesit1 a sesit2

pri spusteni makra mi vyhodi hlasku: Run-time error `9`:
Subscript out of range

kdyz dam debug, vyhodi mi chybu zde: Sheets(soubor).Select

nevi prosim nekdo co s tiim?? :(
predem dekuji!citovat

bach1(23.7.2009 12:27)#000597

Chybí vám tam přípony těch souborů , ze kterých to chcete tahat....ve vašem případě
např. soubory = Array("sesit1.xls", "sesit2.xls", ... )
podmínkou je aby tyto sešity samozřejmě existovaly.
Navíc záložky se musí taky jmenovat sesit1.xls a sesit2.xls.

Pokud by jste to chtěl nechat jak to máte , tak soubory na disku by nesměly mít žádnou příponu xls , tedy jen sesit1 a sesit2 , sám jsem to bez přípon netestoval , tak snad by to takto fungovalo taky , problém by byl jen ten , že windows by nevěděl čím otevřít soubor bez přípony , ale to je jen technická maličkost.

Pro zajímavost já to mám takto:

Sub copy_data_from_files()
'Zkopírování dat ze souborů
Dim soubory, soubor, nazev_souboru, tento_soubor As String
Dim i As Variant
Application.ScreenUpdating = False
soubory = Array("benesov.xls", "breclav.xls", "brno.xls", "bruntal.xls", "cbudejovice.xls", "chomutov.xls", "clipa.xls", "decin.xls", "dubnany.xls", "frydek.xls", "hodonin.xls", "hradec.xls", "jablonec.xls", "jihlava.xls", "kladno.xls", "kolin.xls", "kromeriz.xls", "kvary.xls", "liberec.xls", "louny.xls", "mboleslav.xls", "melnik.xls", "njicin.xls", "olomouc.xls", "opava.xls", "ostrava.xls", "pardubice.xls", "pisek.xls", "plzen.xls", "praha.xls", "pribram.xls", "prostejov.xls", "sumperk.xls", "svitavy.xls", "tabor.xls", "teplice.xls", "trebic.xls", "trutnov.xls", "ustinl.xls", "zlin.xls")

tento_soubor = ThisWorkbook.Name

For Each i In soubory

soubor = i
nazev_souboru = ThisWorkbook.Path + "\" & soubor

Set wb = Workbooks.Open(Filename:=nazev_souboru)
Cells.Select
Selection.Copy

Windows(tento_soubor).Activate
Sheets(soubor).Select
Range("A1").Select
ActiveSheet.Paste

Windows(soubor).Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False

Next

Windows(tento_soubor).Activate
Application.ScreenUpdating = True
Sheets("vyhodnoceni").Select
End Sub

citovat

termitus(23.7.2009 15:13)#000598

muj problem vyresen!!!
Neskonale diiky pro bach1 !!!

Dekuji za Vasi trpelivost a ochotu, velmi jste mi pomohl pri reseni problemu!citovat

Téma: Načtení do listů

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje