Loop variable unique values onto corresponding tab

[Rose401k]

Hello everyone,

I need to take a list of 5,500 rows which have an identifier in Column A and put all the rows associated with that identifier onto a new tab labeled with the identifier.
My identifier is a "Plan Code" and each row contains asset data associated with that Plan. Some plans may have 5 rows of data, some may have 50. It is a variable amount. There are about 300 plan codes in this list of 5500 rows and I need a tab for each one with its asset list.
Here is the code I have so far to populate the variable number of rows depending on the Plan Code. However, I cannot make it loop through each unique identifier to populate on its own sheet (i.e. one tab per Plan Code with all associated assets).
I really appreciate your advice and knowledge on how to turn this little code into a loop as described above, or tips on a different method to use!

*Data is the name of my sheet with the 5500 lines of data
*PlanCode is the nickname I'm using for Column A -"Plan Code"
*Test is the name of another tab -i would like this to turn into the sheet which populates for all the unique Plan Codes

Sub Loop_Assets()
Application.ScreenUpdating = False


Dim PlanCode As String
Dim finalrow As Integer
Dim i As Integer


PlanCode = Sheets("Test").Range("A1").Value
finalrow = Sheets("Data").Range("A500").End(xlUp).Row



For i = 2 To finalrow
If Cells(i, 1) = PlanCode Then


Range(Cells(i, 1), Cells(i, 6)).Copy


Worksheets("Test").Range("B100").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats

End If
Next i


Application.ScreenUpdating = True
End Sub

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub CopyFilter()
   Dim cl As Range
   Dim Ws As Worksheet
   
   Set Ws = Sheets("data")
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      .comparemode = vbTextCompare
      For Each cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(cl.Value) Then
            .Add cl.Value, Nothing
            Ws.Range("A1:[COLOR=#ff0000]Z[/COLOR]1").AutoFilter 1, cl.Value
            Sheets.Add.Name = cl.Value
            Ws.AutoFilter.Range.Copy Range("A1")
         End If
      Next cl
   End With
   Ws.AutoFilterMode = False
End Sub

Change value in red to match the last used column in your data

 

[Rose401k]

This is perfect, exactly what I needed! Plus some interesting new vba I have not used before which will be fun to read up on. Thanks so much!!

 

[Fluff]

Glad to help & thanks for the feedback