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