Copy and Create New Worksheet Tabs from Column Values

wazzulu1

Board Regular
Joined
Oct 4, 2006
Messages
161
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!
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

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
161
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
161

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
161

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
161
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
 

Watch MrExcel Video

Forum statistics

Threads
1,113,850
Messages
5,544,660
Members
410,628
Latest member
mike5
Top