Moving Data to a Different Worksheet

[lgerjets]

I am trying to move rows of data from worksheet 1 to other worksheets based on what name is listed in column B.

Example:
If row 1 had "Bohlmann" in column B, the entire row would go to the "Bohlmann" worksheet
If row 2 had "Madsen" in column B, the entire row would go to the "Madsen" worksheet

I am looking to keep my worksheet 1 with all of the data as is, but sort out the information by column B to different worksheet. Any ideas?

 

[Fluff]

A few questions
1) Do all the other sheets exist?
2) Do you have a header row in row 1 with data starting in row 2?
3) do you want to clear the existing sheets, or add new data at the bottom?

 

[lgerjets]

See below in RED

a few questions
1) do all the other sheets exist? yes
2) do you have a header row in row 1 with data starting in row 2? yes
3) do you want to clear the existing sheets, or add new data at the bottom? add to bottom

 

[Fluff]

try this

Sub FilterCopy()

   Dim Cl As Range
   Dim Ws As Worksheet
   
   Set Ws = Sheets("[COLOR=#ff0000]sheet1[/COLOR]")
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            Ws.Range("A1").AutoFilter 2, Cl.Value
            Ws.UsedRange.Offset(1).SpecialCells(xlVisible).Copy Sheets(Cl.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
         End If
      Next Cl
   End With
   Ws.AutoFilterMode = False
End Sub

Change the sheet name in red to suit

 

[lgerjets]

Thanks, I'll give that a try!

try this

Sub FilterCopy()

   Dim Cl As Range
   Dim Ws As Worksheet
   
   Set Ws = Sheets("[COLOR=#ff0000]sheet1[/COLOR]")
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .Add Cl.Value, Nothing
            Ws.Range("A1").AutoFilter 2, Cl.Value
            Ws.UsedRange.Offset(1).SpecialCells(xlVisible).Copy Sheets(Cl.Value).Range("A" & Rows.Count).End(xlUp).Offset(1)
         End If
      Next Cl
   End With
   Ws.AutoFilterMode = False
End Sub

Change the sheet name in red to suit