Copy Data to a new tab same sheet

marcidee

Board Regular
Joined
May 23, 2016
Messages
196
Office Version
  1. 2019
I have a sheet that I need to send to a client each month - they require each person as seen in column F (Adam , Alaco) in a new tab in the same spreadsheet (there are numerous names in the one sheet) - so in the example below all the data for Adam will go into one sheet, all the data for Alaco will go into the next sheet and Beatrice in the next sheet and so on (same file).


Is there a script that will create a new tab for each person in column F and copy or move the data into that sheet.

If you can help I would be very grateful
[TABLE="width: 791"]
<tbody>[TR]
[TD]BEDF002
[/TD]
[TD]Bedford Borough Council
[/TD]
[TD]Katie
[/TD]
[TD="align: right"]19-Nov-17
[/TD]
[TD]13-Nov-17
[/TD]
[TD]Adam
[/TD]
[TD]0.75
[/TD]
[TD="align: right"]14.96
[/TD]
[TD][/TD]
[TD]11.22
[/TD]
[/TR]
[TR]
[TD]BEDF002
[/TD]
[TD]Bedford Borough Council
[/TD]
[TD]Diana
[/TD]
[TD="align: right"]19-Nov-17
[/TD]
[TD]14-Nov-17
[/TD]
[TD]Adam
[/TD]
[TD]0.75
[/TD]
[TD="align: right"]14.96
[/TD]
[TD][/TD]
[TD]11.22
[/TD]
[/TR]
[TR]
[TD]BEDF002
[/TD]
[TD]Bedford Borough Council
[/TD]
[TD]Katie
[/TD]
[TD="align: right"]19-Nov-17
[/TD]
[TD]15-Nov-17
[/TD]
[TD]Adam
[/TD]
[TD]0.75
[/TD]
[TD="align: right"]14.96
[/TD]
[TD][/TD]
[TD]11.22
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]5.25
[/TD]
[TD][/TD]
[TD][/TD]
[TD]78.99
[/TD]
[/TR]
[TR]
[TD]BEDF002
[/TD]
[TD]Bedford Borough Council
[/TD]
[TD]Josephine
[/TD]
[TD="align: right"]19-Nov-17
[/TD]
[TD]13-Nov-17
[/TD]
[TD]Alaco
[/TD]
[TD]0.50
[/TD]
[TD="align: right"]14.96
[/TD]
[TD][/TD]
[TD]7.48
[/TD]
[/TR]
[TR]
[TD]BEDF002
[/TD]
[TD]Bedford Borough Council
[/TD]
[TD]Katie
[/TD]
[TD="align: right"]19-Nov-17
[/TD]
[TD]14-Nov-17
[/TD]
[TD]Alaco
[/TD]
[TD]0.50
[/TD]
[TD="align: right"]14.96
[/TD]
[TD][/TD]
[TD]7.48
[/TD]
[/TR]
[TR]
[TD]BEDF002
[/TD]
[TD]Bedford Borough Council
[/TD]
[TD]Josephine
[/TD]
[TD="align: right"]19-Nov-17
[/TD]
[TD]15-Nov-17
[/TD]
[TD]Alaco
[/TD]
[TD]0.50
[/TD]
[TD="align: right"]14.96
[/TD]
[TD][/TD]
[TD]7.48
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]3.00
[/TD]
[TD][/TD]
[TD][/TD]
[TD]45.03
[/TD]
[/TR]
[TR]
[TD]BEDF002
[/TD]
[TD]Bedford Borough Council
[/TD]
[TD]Claudia
[/TD]
[TD="align: right"]19-Nov-17
[/TD]
[TD]14-Nov-17
[/TD]
[TD]Beatrice
[/TD]
[TD]0.50
[/TD]
[TD="align: right"]14.96
[/TD]
[TD][/TD]
[TD]7.48
[/TD]
[/TR]
[TR]
[TD]BEDF002
[/TD]
[TD]Bedford Borough Council
[/TD]
[TD]Claudia
[/TD]
[TD="align: right"]19-Nov-17
[/TD]
[TD]15-Nov-17
[/TD]
[TD]Beatrice
[/TD]
[TD]0.50
[/TD]
[TD="align: right"]14.96
[/TD]
[TD][/TD]
[TD]7.48
[/TD]
[/TR]
[TR]
[TD]BEDF002
[/TD]
[TD]Bedford Borough Council
[/TD]
[TD]Claudia
[/TD]
[TD="align: right"]19-Nov-17
[/TD]
[TD]16-Nov-17
[/TD]
[TD]Beatrice
[/TD]
[TD]0.50
[/TD]
[TD="align: right"]14.96
[/TD]
[TD][/TD]
[TD]7.48
[/TD]
[/TR]
[TR]
[TD]Thanks
Marc
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1.50
[/TD]
[TD][/TD]
[TD][/TD]
[TD]22.44


[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
I'm assuming you have headers and the data starts on row2.

Try this, just rename ("Sheet1") to whatever sheet the data is on:

Code:
Sub createnewandmove()

Dim rownum As Long
Dim rownum2 As Long
Dim ws As Worksheet


Set ws = ThisWorkbook.Sheets("Sheet1")
rownum = 2

Do Until ws.Cells(rownum, 7).Value = ""

rownum2 = rownum

Do Until ws.Cells(rownum2, 6).Value = ""
rownum2 = rownum2 + 1
lastrow = rownum2
sheetname = ws.Cells(rownum2 - 1, 6).Value

Loop

ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = sheetname
ws.Rows(rownum & ":" & rownum2).Copy Sheets(sheetname).Range("A1")
rownum = rownum2 + 1

Loop


End Sub
 
Last edited:
Upvote 0
Try this:
Run this script from the sheet with your current data:
Code:
Sub Filter()
'Modified 12-4-17 7:20 PM EST
Application.ScreenUpdating = False
Dim i As Long
Dim b As Long
Dim c As Long
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Dim sn As String
sn = ActiveSheet.Name
Lastrow = Sheets(sn).Cells(Rows.Count, "F").End(xlUp).Row
Sheets.Add(After:=Sheets(sn)).Name = "Temp"
Sheets(sn).Range("F2:F" & Lastrow).Copy Sheets("Temp").Range("A1")
Lastrowa = Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Temp").Range("A1:A" & Lastrowa).RemoveDuplicates 1, xlNo
Sheets(sn).Activate
Lastrowa = Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row
    For i = 1 To Lastrowa
        Sheets.Add(After:=Sheets("Temp")).Name = Sheets("Temp").Cells(i, 1).Value
    Next
 Sheets(sn).Activate
    For b = 2 To Lastrow
        ans = Cells(b, "F").Value
        Rows(b).Copy Sheets(ans).Rows(Sheets(ans).Cells(Rows.Count, "F").End(xlUp).Row + 1)
    Next
    For c = 3 To Lastrowa + 2
     Sheets(sn).Rows(1).Copy Sheets(c).Rows(1)
    Next
MsgBox "I now need to delete a temp sheet I made. Just click Ok and then Delete"
Sheets("Temp").Delete
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you for your reply - the code is breaking at Set ws = ThisWorkbook.Sheets("Sheet1") saying "can't be executed in break mode"

Will this script create a new sheet (or even copy data to a new sheet) wherever it sees a new name in column F - is this even possible? I assume if it can then we would just need to manually create the new tabs first (could be several)

There are headings and the data starts row 2
 
Upvote 0
No I hadn't - I have now (thank you) and it breaks at: Sheets.Add(After:=Sheets("Temp")).Name = Sheets("Temp").Cells(i, 1).Value

I can see that it has created a sheet (temp) with all the names in it- has a blank line between the first name and the second name - so not sure if that is the problem - no data has been transfered
 
Upvote 0
That is because you have one cell in column "F" that is empty or one of those names in column "F" already have a sheet created with this name.

This script creates all the sheets and then copies all the data into those sheets.

I thought that was what you wanted.

Your posting title says:
Copy Data to a new tab same sheet
 
Last edited:
Upvote 0
Another option to try:
Code:
Public Sub SplitByName()
    Dim lngLastRow      As Long
    Dim rngLead         As Excel.Range
    Dim rngArea         As Excel.Range
    Dim wksNew          As Excel.Worksheet
    
    With Sheets("Sheet1") '<-- this needs to refer to YOUR sheet name
        lngLastRow = .Range("G" & .Rows.Count).End(xlUp).Row
        Set rngLead = .Range("A2:A" & lngLastRow)
    End With
    
    For Each rngArea In rngLead.SpecialCells(xlCellTypeConstants).Areas '<-- I assume that the data in column A is constant, and not formulas
        Set wksNew = ThisWorkbook.Worksheets.Add(After:=rngLead.Parent)
        wksNew.Name = rngArea.Resize(1, 1).Offset(, 5).Text '<-- this could giove a RT error if the name is not valid per sheet name rules
        Call rngLead.Resize(1, 1).Offset(-1).EntireRow.Copy(Destination:=wksNew.Range("A1"))
        Application.CutCopyMode = False
        With rngArea
            Call .Resize(.Rows.Count + 1).EntireRow.Copy(Destination:=wksNew.Range("A2"))
            Application.CutCopyMode = False
        End With
    Next rngArea
End Sub

Please pay attention to the remarks I made in the code.

These results should also include your subtotals.
 
Upvote 0
Since your not responding back. I'm going to move on and see if there are some questions here that have not been answered. I'm sure there are numerous other ways to do this.
 
Upvote 0
Hi Jon

That look like it may have worked - I will fully test later - tank you so much
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,967
Members
452,371
Latest member
Frana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top