Dynamic Cut and Paste VBA

[jdb2313]

I am very new to vba and some help creating a code. I need to cut each unique Name record and paste it into it's own new sheet. I tried to find an existing code but had no luck. Can someone help me with this?

Name	Title	Location
Mike	admin	NC
Mike	admin	NC
Mike	Mgmt	NC
Steve	admin	SC
Steve	admin	SC
Scott	Mgmt	MD
Scott	admin	MD

<colgroup><col width="64" span="3" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[My Aswer Is This]

Assuming all the new sheets have been created
And assuming The list of sheet names are in column A of Sheet(1) starting in Row(2)
And this script copies the row to it's proper sheet. It does not cut it.

Run this script from the master sheet.

If these assumptions are not correct please provide specific details

Sub Copy_Row_To_Sheet_Cell_Value()
Application.ScreenUpdating = False
'Modified  10/19/2018  9:29:34 PM  EDT
On Error GoTo M
Dim i As Long
Sheets("Sheet1").Activate
Dim Lastrow As Long
Lastrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Dim Lastrowa As Long
Dim ans As String
    For i = 2 To Lastrow
    
   With Sheets(1)
    
    If .Cells(i, "A").Value <> "" Then
    ans = .Cells(i, "A").Value
    Lastrowa = Sheets(ans).Cells(Rows.Count, "A").End(xlUp).Row + 1
    .Rows(i).Copy Destination:=Sheets(ans).Rows(Lastrowa)
    End If
    
End With
Next
Exit Sub
M:
MsgBox "You do not have a sheet named  " & ans
End Sub

 

[Momentman]

So you would have 3 sheets, one named Mike, another Steve and the third named Scott

 

[Fluff]

Hi & welcome to MrExcel.

This will create the sheets and then copy the data across

Sub SplitToSheet()
   Dim Cl As Range
   Dim Ws As Worksheet
   
   Set Ws = Sheets("Sheet1")
   If Ws.AutoFilterMode Then Ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("A2", Ws.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) Then
            .add Cl.Value, Nothing
            Sheets.add(, Ws).Name = Cl.Value
            Ws.Range("A1").AutoFilter 1, Cl.Value
            Ws.UsedRange.SpecialCells(xlVisible).Copy Sheets(Cl.Value).Range("A1")
         End If
      Next Cl
   End With
   Ws.AutoFilterMode = False
End Sub