Moving Data to new tabs within a workbook

G

Guest

Hello,
What I am trying to do is. I have a sheet with states in column "L" I would
like to have different sate rows moved to a new tab and the the tab named
that state. Some of the state have mulitpal rows and others just have one
row. A Macro perhaps. any sugestion???
 
R

Ron de Bruin

Column L = column 12

I change this line
rng.Columns(12).AdvancedFilter

If your headers start in A1 then try this
Another option is to use the EasyFilter add-in
http://www.rondebruin.nl/easyfilter.htm


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
'This example filter on the first column in the range (change this if needed)
'You see that the last two columns of the worksheet are used to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use the columns)

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
 
G

Guest

WOW You are amazing... it is debugging on .Calculation = CalcMode
If I remove it will it be fine... I think so?

Lime
 
R

Ron de Bruin

it is debugging on .Calculation = CalcMode

Strange, which Excel version ?

It save your calculation setting and set it to manual after that (code run faster then)
And if the macro is ready it restore

Try again in a new test workbook
 
G

Guest

I got it thanks, One more question, The format is not coming over from sheet
one???

Lime
 
R

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top