Yes I would want to run it in the same macro.

Thanks,
Lime

"Ron de Bruin" wrote:

> Hi Lime
>
> You can also do it in the same macro if you want ?
> Do you want to do that ?
>
> --
> Regards Ron de Bruin
> http://www.rondebruin.nl
>
>
> "Ron de Bruin" <[email protected]> wrote in message news:uY%[email protected]...
> > After you create the sheets with the first macro you can run this one to copy the format
> >
> > --
> > Regards Ron de Bruin
> > http://www.rondebruin.nl
> >
> >
> > "Lime" <[email protected]> wrote in message news:[email protected]...
> >> Thanks Again Ron.. Do I put this at the beginning or the end of my code below?
> >>
> >> "Ron de Bruin" wrote:
> >>
> >>> Hi Lime
> >>>
> >>> You can copy the format from "Sheet1" to all other sheets like this
> >>>
> >>> Sub Test()
> >>> Dim sh As Worksheet
> >>>
> >>> Application.ScreenUpdating = False
> >>> For Each sh In ThisWorkbook.Worksheets
> >>> If sh.Name <> "Sheet" Then
> >>> Sheets("Sheet1").Cells.Copy
> >>> With sh.Cells(1, 1)
> >>> .PasteSpecial xlPasteFormats, , False, False
> >>> Application.CutCopyMode = False
> >>> End With
> >>> End If
> >>> Next
> >>> Application.ScreenUpdating = True
> >>> End Sub
> >>>
> >>>
> >>> --
> >>> Regards Ron de Bruin
> >>> http://www.rondebruin.nl
> >>>
> >>>
> >>> "Lime" <[email protected]> wrote in message news:[email protected]...
> >>> > Hello,
> >>> > What I am trying to do is, In coloum "L" sheet1 I have a list of multipal
> >>> > states, I would like to move the changing states to a new worksheet, so all
> >>> > NJ to new sheet, all NY to new sheet, ETC....naming the sheet that state This
> >>> > is the code I'm using, It works great, but for one problem the Format is not
> >>> > coming over from Sheet1. Is there any way to get the format to come over for
> >>> > Sheet1 as it is coping over to the new sheets?
> >>> >
> >>> > The Below code was provided by a member Ron de Bruin, and I am Forever
> >>> > Greatful.
> >>> >
> >>> > Sub Copy_With_AdvancedFilter_To_Worksheets()
> >>> > Dim CalcMode As Long
> >>> > Dim ws1 As Worksheet
> >>> > Dim WSNew As Worksheet
> >>> > Dim rng As Range
> >>> > Dim cell As Range
> >>> > Dim Lrow As Long
> >>> >
> >>> > Set ws1 = Sheets("Sheet1") '<<< Change
> >>> > Set rng = ws1.Range("A1").CurrentRegion '<<< Change
> >>> >
> >>> > With Application
> >>> > CalcMode = .Calculation
> >>> > .Calculation = xlCalculationManual
> >>> > .ScreenUpdating = False
> >>> > End With
> >>> >
> >>> > With ws1
> >>> > rng.Columns(12).AdvancedFilter _
> >>> > Action:=xlFilterCopy, _
> >>> > CopyToRange:=.Range("IV1"), Unique:=True
> >>> > Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
> >>> > .Range("IU1").Value = .Range("IV1").Value
> >>> >
> >>> > For Each cell In .Range("IV2:IV" & Lrow)
> >>> > .Range("IU2").Value = cell.Value
> >>> > Set WSNew = Sheets.Add
> >>> > On Error Resume Next
> >>> > WSNew.Name = cell.Value
> >>> > If Err.Number > 0 Then
> >>> > MsgBox "Change the name of : " & WSNew.Name & " manually"
> >>> > Err.Clear
> >>> > End If
> >>> > On Error GoTo 0
> >>> > rng.AdvancedFilter Action:=xlFilterCopy, _
> >>> > CriteriaRange:=.Range("IU1:IU2"), _
> >>> > CopyToRange:=WSNew.Range("A1"), _
> >>> > Unique:=False
> >>> > WSNew.Columns.AutoFit
> >>> > Next
> >>> > .Columns("IU:IV").Clear
> >>> > End With
> >>> >
> >>> > With Application
> >>> > .ScreenUpdating = True
> >>> > .Calculation = CalcMode
> >>> > End With
> >>> > End Sub
> >>> >
> >>> >
> >>>
> >>>
> >>>
> >
> >
>
>
>
Was this post helpful to you?

Why should I rate a post?



Expand AllCollapse All

Manage Your Profile |Contact us
© 2005 Microsoft Corporation. All rights reserved. Terms of Use |Trademarks
|Privacy Statement