Copy and Create New Worksheet Tabs from Column Values

[wazzulu1]

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!

 

[acw]

Hi

What is the name of the sheet that contains the Column G data you are using?


Tony

 

[wazzulu1]

Customer File

 

[acw]

Hi

Ok, then where I have referenced sheet1 you will have to modify the code to be Customer File.

Tony

 

[wazzulu1]

Is there a way to make it search to row 650 in Column G, regardless of blank cells?

 

[acw]

Sure. Just specify the range in the loop G11:G650

 

[wazzulu1]

Hi;another question:

Is there a way to have a step to copy rows 1 to 10 from another worksheet called "Sales Quota", and insert them at the top of the newly created worksheets in this code below?

I'm trying to put headers into the spreadsheets.

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, 45).Value = Sheets("Sys Dump").Cells(ce.Row, 1).Resize(1, 45).Value
Else
With Sheets(ce.Value)
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 45).Value = Sheets("Sys Dump").Cells(ce.Row, 1).Resize(1, 45).Value
End With
End If
Next ce

End Sub

 

[acw]

Hi

Try this.

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:AS10").Value = Sheets("Sales Quota").Range("A1:AS10").Value
Range("A11").Resize(1, 45).Value = Sheets("Sys Dump").Cells(ce.Row, 1).Resize(1, 45).Value
Else
With Sheets(ce.Value)
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 45).Value = Sheets("Sys Dump").Cells(ce.Row, 1).Resize(1, 45).Value
End With
End If
Next ce

End Sub

HTH

Tony