Copy and Create New Worksheet Tabs from Column Values

wazzulu1

Board Regular
Joined
Oct 4, 2006
Messages
164
Hi;

Is it possible to create new worksheet tabs in a worksheet, based off of column values, say in column G.

So that a macro would look through column G, and create a tab for each unique value, then copy the rows from column A:AS to the new sheet that is associated with that value?

I'm still a newbie needing help.

Thanks!
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814
Hi

How about

Code:
Sub ccc()
  Set dic = CreateObject("scripting.dictionary")
  For Each ce In Range("G1:G" & Cells(Rows.Count, "G").End(xlUp).Row)
    If Not dic.exists(ce.Value) Then
      dic.Add ce.Value, ce.Value
      Sheets.Add after:=Worksheets(Sheets.Count)
      ActiveSheet.Name = ce.Value
      Range("A1").Resize(1, 29).Value = Sheets("sheet1").Cells(ce.Row, 1).Resize(1, 29).Value
    End If
  Next ce
  
End Sub


Tony
 

wazzulu1

Board Regular
Joined
Oct 4, 2006
Messages
164
Hi Tony;

Do I need to reference the sheet name on this line of the macro?

ActiveSheet.Name = ce.Value


The debugger stopped me at this point when I tried to execute it.
 

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814
Hi

Shouldn't need to. I started with a single sheet workbook with the data in column G.

Are you sure the sheet for that name didn't already exist?


Tony
 

wazzulu1

Board Regular
Joined
Oct 4, 2006
Messages
164

ADVERTISEMENT

I think the problem may be that a value does not appear until row 11.

The run time error code was 1004


Also, I need all the rows associated with that value to be copied in each sheet.
 

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624
Hi -
try this long code but will work maybe.( save as the file for testing )
this code will do the following;
1. create unique list in columnIV from columnG of sheet1
2. delete existing sheets from sheets2 to sheets.count
3. create new sheet from unique list in columnIV
4. loop thru each sheet and find the sheetname from sheets1 columnG
5. paste the row data to each sheet.
Code:
Sub sample()
Dim i As Long
Application.ScreenUpdating = False

'create unique list
Sheets(1).Columns("G").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
    "IV1"), Unique:=True
    
'delete sheets
For i = 2 To Sheets.Count
    Application.DisplayAlerts = False
    Sheets(2).Delete
    Application.DisplayAlerts = True
Next

'create new sheets
With Sheets(1)
    For i = 2 To .Range("iv" & Rows.Count).End(xlUp).Row
        Sheets.Add after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = .Cells(i, "iv").Value
    Next
End With
Sheets(1).Columns("iv").ClearContents
    
'gather data
For i = 2 To Sheets.Count
n = 2
    With Sheets(1).Columns("g")
        Set c = .Find(Sheets(i).Name, , , xlWhole)
            If Not c Is Nothing Then
                f = c.Address
                Do
                    Application.CutCopyMode = False
                    c.EntireRow.Copy
                        With Sheets(i).Range("a" & n)
                            .PasteSpecial xlValues
                        End With
                    Application.CutCopyMode = True
                Set c = .FindNext(c)
                n = n + 1
                Loop Until f = c.Address
                
            End If
    End With
Next
Application.ScreenUpdating = True
End Sub
 

wazzulu1

Board Regular
Joined
Oct 4, 2006
Messages
164

ADVERTISEMENT

I have existing tabs with other data, it wiped them out.....


There are 10 existing tabs, the first is "Customer File" that the data is to be copied from
 

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624
ok how many are those existing tabs and what is the sheet name for the data you want to copy into individual sheet?
 

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814
Hi

Ok try

Code:
Sub ccc()
  Set dic = CreateObject("scripting.dictionary")
  For Each ce In Range("G11:G" & Cells(Rows.Count, "G").End(xlUp).Row)
    If Not dic.exists(ce.Value) Then
      dic.Add ce.Value, ce.Value
      Sheets.Add after:=Worksheets(Sheets.Count)
      ActiveSheet.Name = ce.Value
      Range("A1").Resize(1, 29).Value = Sheets("sheet1").Cells(ce.Row, 1).Resize(1, 29).Value
    Else
      With Sheets(ce.Value)
        .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 29).Value = Sheets("sheet1").Cells(ce.Row, 1).Resize(1, 29).Value
      End With
    End If
  Next ce
  
End Sub

It assumes that the data starts in G11, there are no blank entries, and there are no existing sheets that match the name in G11 at the start of the run.

Tony
 

wazzulu1

Board Regular
Joined
Oct 4, 2006
Messages
164
The debugger stopped the macro on this part of the code:

Range("A1").Resize(1, 29).Value = Sheets("sheet1").Cells(ce.Row, 1).Resize(1, 29).Value
 

Forum statistics

Threads
1,140,944
Messages
5,703,312
Members
421,290
Latest member
james90

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
Top