Hello!
I'm trying to fine tune a macro that will essentially take information that
I have summarized on the first page and break it out into individual tabs.
Explanation -- I have a list of Titles and Ref Numbers in the summary tab and
I need the macro to create a sheet for each listing and then format each page
with a Header that References the case number and title listed on the summary
page.

I've figured out how to create all of the pages:

Sub Macro1()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("INPUT").Range("F3")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
End Sub

I can't figure out how to add the formatting now. I tried to add this code
at the end, but it keeps giving me errors...


For Each MyCell In MyRange
With Sheets(MyCell.Value).PageSetup
.LeftHeader = ""
.CenterHeader = MyCell.Offset(0, -3).Name & vbLf & "text" &
MyCell.Offset(0, -2).Name & vbLf & "Text"
.TopMargin = Application.InchesToPoints(0.99)
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
With ActiveSheet.Range("a2", "b2", "c2", "d2", "e2", "f2", "g2",
"h2").Select.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Font
.Name = "Cambria"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMajor
End With
With Range("a2").FormulaR1C1 = "text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "State"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
End With
Next MyCell
End Sub



Any ideas???

Untested, but it did compile (discounting the xl2007 stuff):

Option Explicit
Sub Macro1()
Dim MyCell As Range
Dim MyRange As Range

Set MyRange = Sheets("INPUT").Range("F3")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange.Cells
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell

For Each MyCell In MyRange.Cells
With Sheets(MyCell.Value)
With .PageSetup
.LeftHeader = ""
'changed from .name to .value <---------------
.CenterHeader = MyCell.Offset(0, -3).Value _
& vbLf & "text" & _
MyCell.Offset(0, -2).Value _
& vbLf & "Text"
.TopMargin = Application.InchesToPoints(0.99)
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
With .Range("a2", "b2", "c2", "d2", _
"e2", "f2", "g2", "h2")
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0
.PatternTintAndShade = 0
With .Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.Name = "Cambria"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMajor
End With
End With
With .Range("a2")
.FormulaR1C1 = "text"
.Offset(0, 1).FormulaR1C1 = "Text"
.Offset(0, 1).FormulaR1C1 = "Text"
.Offset(0, 1).FormulaR1C1 = "Text"
.Offset(0, 1).FormulaR1C1 = "State"
.Offset(0, 1).FormulaR1C1 = "Text"
.Offset(0, 1).FormulaR1C1 = "Text"
.Offset(0, 1).FormulaR1C1 = "Text"
End With
End With
Next MyCell
End Sub


abergman wrote:

Hello!
I'm trying to fine tune a macro that will essentially take information that
I have summarized on the first page and break it out into individual tabs.
Explanation -- I have a list of Titles and Ref Numbers in the summary tab and
I need the macro to create a sheet for each listing and then format each page
with a Header that References the case number and title listed on the summary
page.

I've figured out how to create all of the pages:

Sub Macro1()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("INPUT").Range("F3")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
Next MyCell
End Sub

I can't figure out how to add the formatting now. I tried to add this code
at the end, but it keeps giving me errors...

For Each MyCell In MyRange
With Sheets(MyCell.Value).PageSetup
.LeftHeader = ""
.CenterHeader = MyCell.Offset(0, -3).Name & vbLf & "text" &
MyCell.Offset(0, -2).Name & vbLf & "Text"
.TopMargin = Application.InchesToPoints(0.99)
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
With ActiveSheet.Range("a2", "b2", "c2", "d2", "e2", "f2", "g2",
"h2").Select.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Font
.Name = "Cambria"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMajor
End With
With Range("a2").FormulaR1C1 = "text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "State"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
ActiveCell.Offset(0, 1).FormulaR1C1 = "Text"
End With
Next MyCell
End Sub

Any ideas???

--

Dave Peterson