Macro To Create New Sheet (and rename it) based on unique values in column

Maybe:

Sub himynameisiain()

Range("A2").Select
Do Until ActiveCell.Value = ""
    Sheets.Add.Name = ActiveCell.Value
    Sheets("Sheet1").Activate
    ActiveCell.Offset(1).Select
Loop
End Sub

Hi John,

It is only pulling the first value through and not all the unique values in the column. Good start, im just not sure how to change that to look though the whole column. When i run the code above it puts one new tab named, then gives me the following error "run time 1004: method of range '_global' object failed

Try:

Sub AddSheet()
    Application.ScreenUpdating = False
    Dim bottomA As Integer
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim ws As Worksheet
    For Each rng In Range("A2:A" & bottomA)
        If rng <> rng.Offset(1, 0) Then
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(rng.Value)
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = rng.Value
            End If
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Mumps,

Brilliant! Worked a treat to create new tabs with the names. Thank you.

You would happened to know a way which will then pull certain criteria in the same row but different columns into those tabs?

I would need to know which columns you want to copy.

Ok.

It would be columns: b,c,i,m,n

ty

I just want to clarify a few things. In your first post you said

each unique value in a column

Does this mean that in column A there may be duplicate values? For example, there may be three occurrences of the word "Sample" in column A. Only one sheet named "Sample will be created. If this is the case, do you want the data from all three rows that have "Sample" in column A to be copied or are all the values in column A unique?

Yes, there will be several "sample" in column A. However, the rest of the row is unique for that rows "sample".

I would like in our hypothetical situation the three "sample" instances to be copied over if possible?

Try:

Sub AddSheet()
    Application.ScreenUpdating = False
    Dim bottomA As Integer
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim ws As Worksheet
    For Each rng In Range("A2:A" & bottomA)
        If rng <> rng.Offset(1, 0) Then
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(rng.Value)
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = rng.Value
            End If
        End If
    Next rng
    
    For Each ws In Sheets
    If ws.Name <> "Sheet1" Then
        For Each rng In Sheets("Sheet1").Range("A2:A" & bottomA)
            If rng = ws.Name Then
                Sheets("Sheet1").Cells(rng.Row, "B").Resize(, 2).Copy Sheets(rng.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Sheets("Sheet1").Cells(rng.Row, "I").Copy Sheets(rng.Value).Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
                Sheets("Sheet1").Cells(rng.Row, "M").Resize(, 2).Copy Sheets(rng.Value).Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
            End If
        Next rng
    End If
    Next ws
    Application.ScreenUpdating = True
End Sub

Hi Thanks. I have been modifying what you prescribe in the example as my deciding column is column c. However, i am stumped on how to get it to work for your latest post. If per chance you could see if anything im missing. Its bugging at the line highlighted in bold saying "subscript out of range"

    Application.ScreenUpdating = False
    Dim bottomA As Integer
    bottomA = Range("c" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim ws As Worksheet
    For Each rng In Range("c2:c" & bottomA)
        If rng <> rng.Offset(3, 0) Then
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(rng.Value)
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = rng.Value
            End If
        End If
    Next rng
    
    For Each ws In Sheets
    If ws.Name <> "Sheet1" Then
        For Each rng In Sheets("Sheet1").Range("c2:c" & bottomA)
            If rng = ws.Name Then
                Sheets("Sheet1").Cells(rng.Row, "B").Resize(, 2).Copy Sheets(rng.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Sheets("Sheet1").Cells(rng.Row, "I").Copy Sheets(rng.Value).Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
                Sheets("Sheet1").Cells(rng.Row, "M").Resize(, 2).Copy Sheets(rng.Value).Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
            End If
        Next rng
    End If
    Next ws
    Application.ScreenUpdating = True

Use this code to avoid confusion:

Sub AddSheet()
    Application.ScreenUpdating = False
    Dim bottomC As Integer
    bottomC = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim ws As Worksheet
    For Each rng In Sheets("Sheet1").Range("C2:C" & bottomC)
        If rng <> rng.Offset(1, 0) Then
            Set ws = Nothing
            On Error Resume Next
            Set ws = Worksheets(rng.Value)
            On Error GoTo 0
            If ws Is Nothing Then
                Worksheets.Add(After:=Sheets(Sheets.Count)).Name = rng.Value
            End If
        End If
    Next rng
    
    For Each ws In Sheets
    If ws.Name <> "Sheet1" Then
        For Each rng In Sheets("Sheet1").Range("C2:C" & bottomC)
            If rng = ws.Name Then
                Sheets("Sheet1").Cells(rng.Row, "B").Resize(, 2).Copy Sheets(rng.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Sheets("Sheet1").Cells(rng.Row, "I").Copy Sheets(rng.Value).Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
                Sheets("Sheet1").Cells(rng.Row, "M").Resize(, 2).Copy Sheets(rng.Value).Cells(Rows.Count, "D").End(xlUp).Offset(1, 0)
            End If
        Next rng
    End If
    Next ws
    Application.ScreenUpdating = True
End Sub

Regarding the error you get, I am assuming that the sheet containg your data is called "Sheet1". If your sheet has a different name, you'll have to change "Sheet1" in the code to match your sheet name. If that's not the problem, please post a copy of your file. It would make it easier to find a solution when working with the actual data.

Brilliant, thanks! Solved!

(not sure how to change title)

Thank you for the feedback. It was my pleasure. To mark your thread solved do the following:
- Go to the first post
- Click edit
- Click Advance
- Just below the word "Title:" you will see a dropdown with the word No prefix.
- Change to Solve
- Click Save

done! thanks again!