Copy Unique Values and Create sheet for each of them

[Skjoll]

Hi,

I'm currently new in recording basic macro. Can someone help me get the unique values for in the account column and create each account a separate worksheet?


What I currently have is just for 3 items to filter the account columns for each items, copy the contents, create worksheet for each item and paste the contents on the worksheets but I may encounter other accounts than what I currently recorded.

Sub Collapse()
'
' Collapse Macro
'


'
    ActiveSheet.ListObjects("Account").Range.AutoFilter Field:=3, Criteria1:= _
        "Account1"
    Range("Account[#All]").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    ActiveSheet.ListObjects.Add(xlSrcRange, , xlYes).Name = _
        "Account1"
    Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).Formula = "=SUBTOTAL(109,_Account1[Amount])"
    Cells(Rows.Count, "A").End(xlUp).Value = "Total"
    ActiveSheet.Name = "Account1"
    Sheets("GL Transaction").Select
    ActiveSheet.ListObjects("Account").Range.AutoFilter Field:=3, Criteria1:= _
        "Account2"
    Range("Account[#All]").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    ActiveSheet.ListObjects.Add(xlSrcRange, , xlYes).Name = _
        "Account2"
    Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).Formula = "=SUBTOTAL(109,_Account2[Amount])"
    Cells(Rows.Count, "A").End(xlUp).Value = "Total"
    ActiveSheet.Name = "Account2"
    Sheets("GL Transaction").Select
    ActiveSheet.ListObjects("Account").Range.AutoFilter Field:=3, Criteria1:= _
        "Account3"
    Range("Account[#All]").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    ActiveSheet.ListObjects.Add(xlSrcRange, , xlYes).Name = _
        "Account3"
    Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).Formula = "=SUBTOTAL(109,_Account13[Amount])"
    Cells(Rows.Count, "A").End(xlUp).Value = "Total"
    ActiveSheet.Name = "Account13"
    Sheets("GL Transaction").Select
    ActiveSheet.ListObjects("Account").Range.AutoFilter Field:=3
    MsgBox ("Done!")
End Sub

Sorry for a messy code I am just a beginner with no training/basic knowledge or whatsoever.

Thank you very much!

 

[Fluff]

Hi & welcome to MrExcel.
Does this do what you want?

Sub Collapse()
   Dim Cl As Range
   Dim ws As Worksheet
   
   Set ws = Sheets("GL Transaction")
   If ws.FilterMode Then ws.ShowAllData
   With CreateObject("scripting.dictionary")
      For Each Cl In ws.ListObjects("Account").ListColumns(3).DataBodyRange
         If Not .exists(Cl.Value) Then
            Sheets.Add(, ws).name = Cl.Value
            .Add Cl.Value, Nothing
            ws.ListObjects("account").Range.autofilter 3, Cl.Value
            ws.ListObjects("account").Range.Copy Sheets(Cl.Value).Range("A1")
            Sheets(Cl.Value).ListObjects.Add.name = Cl.Value
         End If
      Next Cl
   End With
   ws.ShowAllData
End Sub

 

[Skjoll]

Hi Fluff,

Yes that is very close to what I want. I wanted to understand this code so I may be able to revise it to my liking.
Thank you very much for your support!

 

[Fluff]

Glad to help & thanks for the feedback.
For more info on dictionaries have a look here https://excelmacromastery.com/vba-dictionary/

 

[Skjoll]

Thank you very much this is a lot of help!

 

[Fluff]

You're welcome