Moving Data to new tabs within a workbook

  • Thread starter Thread starter Guest
  • Start date Start date
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???
 
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
 
WOW You are amazing... it is debugging on .Calculation = CalcMode
If I remove it will it be fine... I think so?

Lime
 
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
 
I got it thanks, One more question, The format is not coming over from sheet
one???

Lime
 
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

Back
Top