Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem Excel: postupné kopírování z různých listů do jednoho (makro?)

Název threadu se mi moc nepovedl, vysvětlím podrobně tady.

Soubor s příkladem je v příloze.

Mám *xlsx, kde jsou listy "List1" až "List3" a list "vystup".

1. Na listech 1-3 se nachází seznamy, které mohou být libovolně dlouhé. Vždy ale začínají v určené buňce, v příkladu jsou označeny žlutě. Mezi řádky s položkami nejsou mezery.
2. Může se stát, že na listu nebude ani jedna položka.
3. Potřebuji výsledek, tedy seznam položek z listů 1-3 dostat na list "vystup" a to tak, že nejprve se překopírují všechny položky z listu 1 (tedy od C4 dolů), pak z dvojky (od G2) a nakonec z trojky (od C13)

Mělo by se tedy nějak při kopírování otestovat, "kam až seznam na daném listě sahá", seznam zkopírovat a vložit na první volný řádek listu "vystup" do sloupce A.

Texty jsem uvedl jako příklad, ve skutečnosti jde vždy o výsledek složitého vzorce. Potřebuji, aby kopírování provedlo ten jako text, žádné přepočítánání. Tedy pravděpodobně "vložit jako hodnoty".

Př.:
chci kopírovat tohle (a chci, aby to takto jako text bylo na listu "vystup":

<VetaB2 c_evid_dd="16001" c_radku="2" dan1="21,00" dan2="1500,11" dic_dod="00112233" dppd="06.02.2016" pomer="N" zakl_dane1="100,00" zakl_dane2="10000,42" />

přitom tohle je výsledek vzorečku:

="<VetaB2 "&KDYŽ(A2="";"";$A$1&"="""&A2&""" ")&KDYŽ(B2="";"";$B$1&"="""&B2&""" ")&KDYŽ(C2="";"";$C$1&"="""&HODNOTA.NA.TEXT(C2;"0, 00")&""" ")&KDYŽ(D2="";"";$D$1&"="""&HODNOTA.NA.TEXT(D2;"0, 00")&""" ")&KDYŽ(E2="";"";$E$1&"="""&HODNOTA.NA.TEXT(E2;"0, 00")&""" ")&KDYŽ(F2="";"";$F$1&"="""&F2&""" ")&KDYŽ(G2="";"";$G$1&"="""&HODNOTA.NA.TEXT(G2;"dd .mm.rrrr")&""" ")&KDYŽ(H2="";"";$H$1&"="""&H2&""" ")&KDYŽ(I2="";"";$I$1&"="""&HODNOTA.NA.TEXT(I2;"0, 00") &""" ")&KDYŽ(J2="";"";$J$1&"="""&HODNOTA.NA.TEXT(J2;"0, 00")&""" ")&KDYŽ(K2="";"";$K$1&"="""&HODNOTA.NA.TEXT(K2;"0, 00")&""" ")&KDYŽ(L2="";"";$L$1&"="""&L2&""" ")&"/>"

Takto by to vypadalo, kdybych znal přesnou délku seznamů na listech 1-3

Sub Makro1()
'
' Makro1 Makro
'

'
    Sheets("List1").Select
    Range("C4:C6").Select
    Selection.Copy
    Sheets("vystup").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("List2").Select
    Range("G2:G3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("vystup").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("List3").Select
    Range("C13:C18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("vystup").Select
    Range("A6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub

Jenže ji neznám. A také může být některý seznam prázdný.

Pomožte, poraďte.
Díky moc!

Předmět Autor Datum
prečo pripúšťaš taký bordel v zdrojových hárkoch? a) Prečo nemáš vo všetkých zdrojových hárkoch pevn…
robert13 01.12.2015 17:30
robert13
Díky, musím to trochu upřesnit (a zdroje jsem upravil). Na jednotlivých listech je samozřejmě mnohe… nový
L-Core 01.12.2015 19:52
L-Core
Pokiaľ platí, že hárky sú v zošite usporiadané v tomto poradí, nie je potrebné v načítavaní hárkov n… nový
robert13 01.12.2015 20:35
robert13
1. Listů je v sešitě mnohem více 2. Potřebné listy nejsou nijak seřazeny. - můžu je seřadit, aby byl… nový
L-Core 01.12.2015 21:03
L-Core
ok, moment nový
robert13 01.12.2015 21:08
robert13
Tu máš úplne jedno, kde sa zdrojové i cieľový hárok nachádzajú, akonáhle však dôjde kód k príkazu na… nový
robert13 01.12.2015 21:28
robert13
Funguje :-) Je to pěkné, když to s Excelem umíš, takové to "for 1 = 0 to 9" spolu s "if"... Pokud b… nový
L-Core 01.12.2015 22:18
L-Core
ano, ale nefunguje to pre dodatočné pridanie hárkov, aby Ti do výsledkového hárka pridalo k už exist… poslední
robert13 01.12.2015 22:25
robert13

prečo pripúšťaš taký bordel v zdrojových hárkoch?
a) Prečo nemáš vo všetkých zdrojových hárkoch pevne zadanú bunku, kde začína tabuľka?
Akože... nie že by to nešlo ale zbytočne to komplikuje...
b) To na každom hárku bude iba jeden stĺpec údajov?
c) Priložený kód urobí to, čo chceš, ale ak ho pochopíš, zistíš, že aktuálne oblasti na zdrojových hárkoch musia byť súvislé.
(V Tvojom príklade síce súvislé sú, ale ako to bude v ostatných prípadoch, ktoré sa môžu vyskytnúť?)
Kód pracuje so súvislou oblasťou odvodenou od poslednej bunky.
d) Kód si zistí počet hárkov, pričom posledný považuje za sumarizačný.
e) Kód neošetruje stav, keď dodatočne pridáš ďalšie hárky (neprilepí obsah novopriloženého hárka za výsledkový zoznam).
Musel by si zmazať celý obsah výsledkového hárka a nechať prebehnúť znova
f) To, že niektorý zoznam môže byť prázdny chápem ako prázdny hárok, lebo ako vravím vyššie, kód si zisťuje poslednú vyplnenú bunku na hárku a od nej si odvodzuje oblasť pre kopírovanie...
g) Samozrejme, že keď do zošita zahrnieš makro, musíš ho uložiť vo formáte xlsm

Sub Sustredenie()
    Application.ScreenUpdating = False
    RiadokCiela = 1
    For i = 1 To ActiveWorkbook.Sheets.Count - 1
        Sheets(i).Select
        Selection.SpecialCells(xlCellTypeLastCell).Select
        Selection.CurrentRegion.Select
        PocetRiadkov = Selection.Rows.Count
        If PocetRiadkov = 1 And ActiveCell = "" Then PocetRiadkov = 0
        Selection.Copy
        Sheets(ActiveWorkbook.Sheets.Count).Select
        Range("A" & RiadokCiela).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        RiadokCiela = RiadokCiela + PocetRiadkov
    Next i
    Application.CutCopyMode = False
    For i = 1 To ActiveWorkbook.Sheets.Count
        Sheets(i).Select
        Range("A1").Select
    Next i
    Application.ScreenUpdating = True
End Sub

Díky, musím to trochu upřesnit (a zdroje jsem upravil).

Na jednotlivých listech je samozřejmě mnohem více údajů, ale seznam z jednotlivých listů začíná vždy na buňce M2 (takže M2, M3,... Mx). Pod poslední položkou už nic není.

Seznam se bude vytvářet z těchto listů (pořadí je nutno dodržet).
Jejich přesné názvy jsou:

a0
a1
a2
a3
a4
a5
b1
b2
b3
c

(ty názvy už změnit nemohu, je na to navázáno spousta rozsáhlých maker)

Pokud na některém zdrojovém listu není nic v buňce M2, přeskočí se na další list. V cílovém listu začíná seznam v buňce A1.

Pokiaľ platí, že hárky sú v zošite usporiadané v tomto poradí, nie je potrebné v načítavaní hárkov nič meniť, zmením len zistenie rozsahu buniek v stĺpci M.
Kód postupne berie do radu hárky od prvého (v zošite) až po predposledný a naukladá údaje do posledného hárka.
Pokiaľ v zošite nie sú ďalšie hárky, tak nie je dôvod, prečo by to nemalo fungovať aj bez uvádzania ich mien. Alebo ich chceš načítavať podľa mien hárkov? Potom sa to totiž komplikuje a nabaľuje... treba ošetriť, či nenastane chyba (napr omylom sa v zošite nebude vyskytovať niektorý z uvedených hárkov alebo omylom bude nazvaný inak a pod...)
Mám chápať, že hárok "c" je ten výsledkový, alebo výsledkový je ešte ďalší voči uvedeným?

Riešiť budem až po odpovedi...

1. Listů je v sešitě mnohem více
2. Potřebné listy nejsou nijak seřazeny.
- můžu je seřadit, aby byly na konci, tedy nejprve řada jiných listů (nepotřebných pro výsledný seznam), pak zdrojové listy a0-c a nakonec list s výsledným seznamem.
- v každém případě budou vždy přítomny všechny uvedené ZDROJOVÉ listy a budou se jmenovat, jak jsem uvedl, tedy

a0
a1
a2
a3
a4
a5
b1
b2
b3
c

3. výsledný seznam bude v listu, který se jmenuje "KH-vysledek". Ten zařadím jako úplně poslední list sešitu.
4. Ze zdrojových stránek se bere jako první hodnota v buňce M2. V buňce nad ní, v M1, je nějaký text (nadpis), který kopírovat do seznamu nechci. V případě nutnosti mohu obsah M1 smazat. M2 ale posunout nahoru nemohu, seznam musí začínat vždy tam.

---
:?:
K té změně pořadí listů v sešitu: snad předpokládám správně, že jejich přehození nijak neovlivní vazby/vzorečky a kopírování mezi listy. kopírovací makra mám dělané vždy tak, že se jmenovitě odkazuje na konkrétní list (ne na nějaké pořadí listu v sešitu)...

Tu máš úplne jedno, kde sa zdrojové i cieľový hárok nachádzajú, akonáhle však dôjde kód k príkazu na odvolanie sa na neexistujúci hárok, vykonávanie bude prerušené v tom stave, k akému sa dostal, než narazil na chybu a tam dá hlášku o chybe.
Údaje v stĺpci M musia byť súvislé, inak dôjde k označeniu oblasti len po prvú prázdnu bunku.

Sub Sustredenie()
    On Error GoTo Chyba
    Harky = Array("a0", "a1", "a2", "a3", "a4", "a5", "b1", "b2", "b3", "c")
    Harok = "KH-vysledek"
    Application.ScreenUpdating = False
    Sheets(Harok).Select
    RiadokCiela = 1
    For i = 0 To 9
        Harok = Harky(i)
        Sheets(Harky(i)).Select
        If Range("M2") = "" Then GoTo Dalsi
        If Range("M3") = "" Then
            Range("M2").Select
            Else: Range("M2:M" & Range("M2").End(xlDown).Row).Select
        End If
        PocetRiadkov = Selection.Rows.Count
        Selection.Copy
        Sheets("KH-vysledek").Select
        Range("A" & RiadokCiela).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets(Harky(i)).Select
        Range("A1").Select
        RiadokCiela = RiadokCiela + PocetRiadkov
Dalsi:
    Next i
    Sheets("KH-vysledek").Select
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "Zlučovanie úspešne dokončené.", vbInformation, "Hotovo"
    Exit Sub
Chyba:
    Application.ScreenUpdating = True
    If Harok = "KH-vysledek" Then GoTo EVR
    Sheets("KH-vysledek").Select
    Range("A1").Select
EVR:
    MsgBox "Hárok """ & Harok & """ neexistuje!" & Chr(13) & "Zlučovanie bolo pozastavené!", vbCritical, "Chyba"
End Sub

Funguje :-)
Je to pěkné, když to s Excelem umíš, takové to "for 1 = 0 to 9" spolu s "if"...

Pokud bych potřeboval přidat či změnit další listy do vytvářeného seznamu (vždy se začátkem v M2), změnil bych

Harky = Array("a0", "a1", "a2", "a3", "a4", "a5", "b1", "b2", "b3", "c")

s uvedením požadovaného pořadí

a

For i = 0 To 9

podle skutečného počtu zdrojových listů, v případě 12 listů by to bylo:

For i = 0 To 11

.

Je tomu tak?

ano, ale nefunguje to pre dodatočné pridanie hárkov, aby Ti do výsledkového hárka pridalo k už existujúcemu zlúčenému zoznamu údaje dodatočne pridaného hárka.
Pokiaľ makro znova spustíš, začína to znova od začiatku (samozrejme aby vo výsledkovom hárku neostali zvyšky predchádzajúceho zlúčenia, treba stĺpec "A" výsledkového hárka pred opätovným spustením vymazať, prípadne sa to môže doplniť do makra, nech automaticky pred novým zlučovaním zmaže pôvodný výsledok...)
Tu máš aj s doplneným výmazom obsahu stĺpca "A" vo výsledkovom hárku pred vytvorením nového zlúčeného zoznamu:

Sub Sustredenie()
    On Error GoTo Chyba
    Harky = Array("a0", "a1", "a2", "a3", "a4", "a5", "b1", "b2", "b3", "c")
    Harok = "KH-vysledek"
    Application.ScreenUpdating = False
    Sheets(Harok).Select
    Columns("A:A").ClearContents
    Range("A1").Select
    RiadokCiela = 1
    For i = 0 To 9
        Harok = Harky(i)
        Sheets(Harky(i)).Select
        If Range("M2") = "" Then GoTo Dalsi
        If Range("M3") = "" Then
            Range("M2").Select
            Else: Range("M2:M" & Range("M2").End(xlDown).Row).Select
        End If
        PocetRiadkov = Selection.Rows.Count
        Selection.Copy
        Sheets("KH-vysledek").Select
        Range("A" & RiadokCiela).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Sheets(Harky(i)).Select
        Range("A1").Select
        RiadokCiela = RiadokCiela + PocetRiadkov
Dalsi:
    Next i
    Sheets("KH-vysledek").Select
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "Zlučovanie úspešne dokončené", vbInformation, "Hotovo"
    Exit Sub
Chyba:
    Application.ScreenUpdating = True
    If Harok = "KH-vysledek" Then GoTo EVR
    Sheets("KH-vysledek").Select
    Range("A1").Select
EVR:
    MsgBox "Hárok """ & Harok & """ neexistuje!" & Chr(13) & "Zlučovanie bolo pozastavené!", vbCritical, "Chyba"
End Sub

Zpět do poradny Odpovědět na původní otázku Nahoru