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?)

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

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny