Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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?? |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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?? |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
template creates invoice - how to create summary worksheet? | Excel Discussion (Misc queries) | |||
A Macro for Multiple Sheets that Reference one Summary Page | Excel Programming | |||
Macro to Protect Mult Sheets / but allow Pivot Tables... | Excel Worksheet Functions | |||
mult. w/sheets need identical view when opening (range, mag, cell) | Setting up and Configuration of Excel | |||
Macro to split mult text in the cell to separate cells | Excel Programming |