Dynamic Cut and Paste VBA

jdb2313

New Member
Joined
Oct 19, 2018
Messages
7
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?
NameTitleLocation
MikeadminNC
MikeadminNC
MikeMgmtNC
SteveadminSC
SteveadminSC
ScottMgmtMD
ScottadminMD

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

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,077
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

Code:
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

Well-known Member
Joined
Jan 11, 2012
Messages
3,963
So you would have 3 sheets, one named Mike, another Steve and the third named Scott
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,523
Office Version
365
Platform
Windows
Hi & welcome to MrExcel.

This will create the sheets and then copy the data across
Code:
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
 
Last edited:

Forum statistics

Threads
1,078,442
Messages
5,340,305
Members
399,366
Latest member
ahmed elsaid

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top