Moving Changing Data to New worksheets

[Guest]

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

 

[Ron de Bruin]

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

 

[Guest]

Thanks Again Ron.. Do I put this at the beginning or the end of my code below?

 

[Ron de Bruin]

After you create the sheets with the first macro you can run this one to copy the format

 

[Ron de Bruin]

Hi Lime

You can also do it in the same macro if you want ?
Do you want to do that ?

 

[Guest]

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

Thanks,
Lime