Create several sheets

J

Joe

I have a table in sheet "Sheet1" and range A1..Z25.

I want to create a bunch of sheets based on what's
in "Sheet1".

The number of new sheets will be the number of columns
from column C - column Z on "Sheet1". On each new sheet:
- Column A will be the values in Column B on "Sheet1"
- Column B will be the value in row 1 on "Sheet1"
- Column C will be the value in column C-Z on "Sheet1".

Example:

Sheet1
A B C D E ...
1 desc acct TX FL NY
2 cash 1000 500.00 125.00 75.00
3 a/r 1250 750.00 165.00 450.00
..
..
..

New Sheet 1:
A B C
1 1000 TX 500.00
2 1250 TX 750.00
..
..
..

New Sheet 2:
A B C
1 1000 FL 125.00
2 1250 FL 165.00
..
..
..


THANKS!!
 
D

Dave Peterson

How about a little macro--it'll essentially do a series of copy|paste special
transposes (actually just assigns values):

Option Explicit
Sub testme01()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim iCol As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim myRng As Range

Set curWks = Worksheets("sheet1")

With curWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 3
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

For iCol = FirstCol To LastCol
Set newWks = Worksheets.Add

Application.DisplayAlerts = False
On Error Resume Next
Worksheets(.Cells(1, iCol).Value).Delete
On Error GoTo 0
Application.DisplayAlerts = True
newWks.Name = .Cells(1, iCol).Value

Set myRng = .Range(.Cells(FirstRow, "B"), .Cells(LastRow, "B"))
newWks.Range("a1").Resize(myRng.Rows.Count, 1).Value _
= myRng.Value
newWks.Range("b1").Resize(myRng.Rows.Count, 1).Value _
= .Cells(1, iCol).Value
newWks.Range("C1").Resize(myRng.Rows.Count, 1).Value _
= .Cells(FirstRow, iCol).Resize(myRng.Rows.Count, 1).Value
Next iCol
End With
End Sub

Run it against a test copy of your workbook--it deletes existing worksheets that
have state abbreviations for names.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
G

Guest

Exactly!! Thank you so much for your help.
-----Original Message-----
How about a little macro--it'll essentially do a series of copy|paste special
transposes (actually just assigns values):

Option Explicit
Sub testme01()

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim iCol As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim myRng As Range

Set curWks = Worksheets("sheet1")

With curWks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 3
LastCol = .Cells(1, .Columns.Count).End (xlToLeft).Column

For iCol = FirstCol To LastCol
Set newWks = Worksheets.Add

Application.DisplayAlerts = False
On Error Resume Next
Worksheets(.Cells(1, iCol).Value).Delete
On Error GoTo 0
Application.DisplayAlerts = True
newWks.Name = .Cells(1, iCol).Value

Set myRng = .Range(.Cells
Click to expand...
(FirstRow, "B"), .Cells(LastRow, "B"))
 
Top