Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Moving Changing Data to New worksheets
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Moving Changing Data to New worksheets
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


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,123
Default Moving Changing Data to New worksheets
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" wrote in message ...
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




Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Moving Changing Data to New worksheets
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" wrote in message ...
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





Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,123
Default Moving Changing Data to New worksheets
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" wrote in message ...
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" wrote in message ...
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







Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,123
Default Moving Changing Data to New worksheets
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" wrote in message ...
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" wrote in message ...
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" wrote in message ...
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









Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 56
Default Moving Changing Data to New worksheets
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" wrote in message ...
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" wrote in message ...
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" wrote in message ...
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










Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

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
Moving data between worksheets ... Ian Edmont Excel Discussion (Misc queries) 5 January 19th 06 09:32 AM
Moving data between worksheets ... Ian Edmont Excel Worksheet Functions 4 January 19th 06 09:32 AM
Moving Changing data to new tab in workbook Lime Excel Worksheet Functions 0 November 23rd 05 03:33 PM
Moving Data Between Worksheets WilliamVierra Excel Programming 3 August 17th 05 03:52 PM
Moving data between worksheets Joe Excel Worksheet Functions 0 January 27th 05 08:38 PM


All times are GMT +1. The time now is 07:49 AM.

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

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement