A
abergman
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???
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???