Ako rozdeliť údaje z jedného hárka do viacerých hárkov čo najrýchlejšie?

Alexandra sa pýta:

Dobrý deň,
v tabuľke sú údaje ako pobočka, osobné číslo, meno, benefit, počet, suma a ja potrebujem spraviť, aby som rozdelila obsah hárka do jednotlivých hárkov podľa pobočiek, čiže jeden hárok bude ako podklad a ďalší bude pobocka 50010 a budú tam osoby, osobné čísla, v ďalšom hárku 50014 a to isté…

Tu je ukážka súboru:

Možných riešení je viacero. My si ukážeme to najrýchlejšie😀 a tým je použitie makra. Základy vytvárania a používania makier nájdete napr. v článku https://pohodovainformatika.sk/ms-word/vytvaranie-makier-vo-worde/. Dnes budeme vychádzať z makra uvedeného v článku https://pohodovainformatika.sk/pytate-sa/ako-v-exceli-automaticky-vytvorit-a-pomenovat-viac-harkov/ a jemne ho upravíme. Začneme podobne:

Sub RozdelDoHarkov()
    Dim Zosit As Workbook
    Dim Harok As Worksheet
    Dim BunkaSPobockou As Range
    Dim RozsahBuniek As Range
    Dim NazovHarka As String
    Dim NajdenyHarok As Boolean
    Dim Rozsah As Range
    Dim PoslednyRiadok As Long
    Set Harok = ActiveSheet
    Set Zosit = ActiveWorkbook
    Set RozsahBuniek = Selection
    For Each BunkaSPobockou In RozsahBuniek
        NazovHarka = BunkaSPobockou.Value
        If NazovHarka = "" Then Exit Sub
        On Error Resume Next
        Zosit.Sheets(NazovHarka).Select
        NajdenyHarok = (Err = 0)
        On Error GoTo 0
        If NajdenyHarok Then
            ' MsgBox "Hárok s názvom '" & NazovHarka & "' už existuje!"
        Else
            With Zosit
                Sheets("Hárok1").Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = BunkaSPobockou.Value
                PoslednyRiadok = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
                Set Rozsah = ActiveSheet.Range("A2:A" & PoslednyRiadok)
                For i = Rozsah.Cells.Count To 1 Step -1
                    If Rozsah.Item(i).Value <> BunkaSPobockou.Value Then
                        Rozsah.Item(i).EntireRow.Delete
                    End If
                Next i
            End With
        End If
    Next BunkaSPobockou
End Sub

• stlačíme klávesovú skratku ALT+F8;
• napíšeme názov makra RozdelDoHarkov;
• klikneme na Vytvoriť;
• následne do otvoreného okna vložíme nasledovný kód:

Uložíme ako súbor podporujúci makrá a hotovo.

Makro použijeme nasledovne:

• v hárku Hárok1 označíme údaje s ID pobočiek v stĺpci A;
• stlačíme ALT+F8;
• klikneme na makro RozdelDoHarkov;
• klikneme na Spustiť a je to.

Materiály na stiahnutie:

• makro je súčasťou súboru nižšie