Macro Creates Mult Sheets Based on Summary
 

Alright,
So I'm working on a macro that takes info from my summary sheet (Names and
Numbers) and breaks out each one into its own sheet and formats the sheet
using those names and numbers in the headers. So far, I can figure out how to
break out the sheets, but I'm running into problems with the formatting for
some reason!
This is what I have for the new sheet creation and naming:
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

Easy enough.
For the formatting, I'm trying to add this in before the 'Next MyCell', but
I keep getting errors.

For Each MyCell In MyRange
With Sheets(MyCell.Value).PageSetup
.LeftHeader = ""
.CenterHeader = MyCell.Offset(0, -3).Name & vbLf & "Number" &
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 = "TEXT"
ActiveCell.Offset(0, 1).FormulaR1C1 = "TEXT"
ActiveCell.Offset(0, 1).FormulaR1C1 = "TEXT"
ActiveCell.Offset(0, 1).FormulaR1C1 = "TEXT"
End With
Next MyCell
End Sub

I don't think its liking the pagesetup or the "next mycell" at the end. I
have no idea.... Any clues as to what is going on, or suggestions on
different code to use??

Macro Creates Mult Sheets Based on Summary
 

Check your earlier post.

abergman wrote:

Alright,
So I'm working on a macro that takes info from my summary sheet (Names and
Numbers) and breaks out each one into its own sheet and formats the sheet
using those names and numbers in the headers. So far, I can figure out how to
break out the sheets, but I'm running into problems with the formatting for
some reason!
This is what I have for the new sheet creation and naming:
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

Easy enough.
For the formatting, I'm trying to add this in before the 'Next MyCell', but
I keep getting errors.

For Each MyCell In MyRange
With Sheets(MyCell.Value).PageSetup
.LeftHeader = ""
.CenterHeader = MyCell.Offset(0, -3).Name & vbLf & "Number" &
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 = "TEXT"
ActiveCell.Offset(0, 1).FormulaR1C1 = "TEXT"
ActiveCell.Offset(0, 1).FormulaR1C1 = "TEXT"
ActiveCell.Offset(0, 1).FormulaR1C1 = "TEXT"
End With
Next MyCell
End Sub

I don't think its liking the pagesetup or the "next mycell" at the end. I
have no idea.... Any clues as to what is going on, or suggestions on
different code to use??

--

Dave Peterson

Macro Creates Mult Sheets Based on Summary
 

Hi

Assuming that the workbook only contain the "INPUT" sheet before the macro
is ran, try this:

Sub Macro1()
Dim MyCell As Range, MyRange As Range
Dim Counter As Long, HeaderCell As Range

Application.ScreenUpdating = False

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

Set HeaderCell = Sheets("INPUT").Range("F3")
For Each sh In ThisWorkbook.Sheets
If sh.Name < "INPUT" Then
With sh.PageSetup
.LeftHeader = ""
.CenterHeader = HeaderCell.Offset(0, -3).Value & vbLf & "Number"
_
& HeaderCell.Offset(0, -2).Value & vbLf & "TEXT"
.TopMargin = Application.InchesToPoints(0.99)
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
Set MyRange = sh.Range("A2:H2")
With MyRange.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With MyRange.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With MyRange.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 sh.Range("a2")
.FormulaR1C1 = "TEXT"
.Offset(0, 1).FormulaR1C1 = "TEXT"
.Offset(0, 2).FormulaR1C1 = "TEXT"
.Offset(0, 3).FormulaR1C1 = "TEXT"
.Offset(0, 4).FormulaR1C1 = "TEXT"
.Offset(0, 5).FormulaR1C1 = "TEXT"
.Offset(0, 6).FormulaR1C1 = "TEXT"
.Offset(0, 7).FormulaR1C1 = "TEXT"
End With
Set HeaderCell = HeaderCell.Offset(1, 0)
End If

Next
Application.ScreenUpdating = True
End Sub

Regards,
Per

"abergman" skrev i meddelelsen
...
Alright,
So I'm working on a macro that takes info from my summary sheet (Names and
Numbers) and breaks out each one into its own sheet and formats the sheet
using those names and numbers in the headers. So far, I can figure out how
to
break out the sheets, but I'm running into problems with the formatting
for
some reason!
This is what I have for the new sheet creation and naming:
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

Easy enough.
For the formatting, I'm trying to add this in before the 'Next MyCell',
but
I keep getting errors.

For Each MyCell In MyRange
With Sheets(MyCell.Value).PageSetup
.LeftHeader = ""
.CenterHeader = MyCell.Offset(0, -3).Name & vbLf & "Number" &
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 = "TEXT"
ActiveCell.Offset(0, 1).FormulaR1C1 = "TEXT"
ActiveCell.Offset(0, 1).FormulaR1C1 = "TEXT"
ActiveCell.Offset(0, 1).FormulaR1C1 = "TEXT"
End With
Next MyCell
End Sub

I don't think its liking the pagesetup or the "next mycell" at the end. I
have no idea.... Any clues as to what is going on, or suggestions on
different code to use??