Excel sloučení dat z více sloupců

[mkortus]

Dobrý den,
potřeboval bych zkombinovat data z více sloupců (na více listech) do jednoho součtového. Viz příloha. Na součtovém listu "celkem" by měly být uvedeny všechny účty, které se vyskytly v kterémkoli z listů 1-5, a to bez duplicit.
Děkuji za pomoc.

[Reklama]

[cmuch]

Ahoj,
zkus toto:

Kód: Vybrat vše

Sub duplicita()

    Sheets("celkem").Select
    Columns("A").Delete
   
    Sheets("List1").Select
    Range(Range("A1"), Range("A1").End(xlDown)).Copy
   
    Sheets("celkem").Select
    Range("A1").PasteSpecial
   
    Sheets("List2").Select
    Range(Range("A1"), Range("A1").End(xlDown)).Copy
   
    Sheets("celkem").Select
    Range("A1").Offset(Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count, 0).PasteSpecial
   
    Sheets("List3").Select
    Range(Range("A1"), Range("A1").End(xlDown)).Copy
   
    Sheets("celkem").Select
    Range("A1").Offset(Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count, 0).PasteSpecial
   
    Sheets("List4").Select
    Range(Range("A1"), Range("A1").End(xlDown)).Copy
   
    Sheets("celkem").Select
    Range("A1").Offset(Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count, 0).PasteSpecial
   
    Sheets("List5").Select
    Range(Range("A1"), Range("A1").End(xlDown)).Copy
   
    Sheets("celkem").Select
    Range("A1").Offset(Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count, 0).PasteSpecial
   
    ActiveSheet.Range(Range("A1"), Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A1").Select
End Sub


[mkortus]

Díky, ale nefunguje.
Jen to nakopíruje čísla účtů (s názvem sloupce :)) do posledního listu.
Neodstraňuje to duplicity.

[cmuch]

Jelikož máš asi excel 2003 tak tam to nefunguje. Tady je náprava.
místo

Kód: Vybrat vše

ActiveSheet.Range(Range("A1"), Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo

vlož toto

Kód: Vybrat vše

 ' pouziti rozsireneho filtru
    Range(Range("A1"), Range("A1").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "B1"), Unique:=True
    Columns("A:A").Delete Shift:=xlToLeft