Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,533
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
template creates invoice - how to create summary worksheet? Tony Barratt Excel Discussion (Misc queries) 13 November 25th 11 09:14 PM
A Macro for Multiple Sheets that Reference one Summary Page abergman Excel Programming 1 February 13th 09 09:46 PM
Macro to Protect Mult Sheets / but allow Pivot Tables... Chris Excel Worksheet Functions 0 November 13th 08 06:37 PM
mult. w/sheets need identical view when opening (range, mag, cell) Peter Setting up and Configuration of Excel 2 February 12th 07 12:28 AM
Macro to split mult text in the cell to separate cells floss Excel Programming 2 June 5th 04 06:17 PM


All times are GMT +1. The time now is 03:02 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"