ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Separate (https://www.excelbanter.com/excel-programming/430377-separate.html)

Sal
Separate
 

I want to change this part of the macro €śFor Each ws In
ThisWorkbook.Worksheets€ť (I think) so that Sheet2, Sheet3, Sheet4, and Sheet5
will be excluded from the macro below. Can you tell me how I would do that?

Sub Separate ()
Sheets.Add.Name = "C"
Sheets.Add.Name = "I"
Sheets("sheet1").Activate
Range("A1:L1").Copy
Sheets("C").Activate
Range("A1").PasteSpecial
Sheets("I").Activate
Range("A1").PasteSpecial

Dim lr As Long
Dim ws As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "sheet1" Then
With Sheets("sheet1").Rows("1:" & lr)
..AutoFilter Field:=4, Criteria1:=ws.Name
..Offset(1).Copy Destination:=ws.Range("A2:L65000")
..AutoFilter
End With
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

joel
Separate
 


Sub Separate ()
Sheets.Add.Name = "C"
Sheets.Add.Name = "I"
Sheets("sheet1").Activate
Range("A1:L1").Copy
Sheets("C").Activate
Range("A1").PasteSpecial
Sheets("I").Activate
Range("A1").PasteSpecial

Dim lr As Long
Dim ws As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets

If ws.Name < "sheet1" and _
ws.Name < "sheet2" and _
ws.Name < "sheet3" and _
ws.Name < "sheet4" and _
ws.Name < "sheet5" Then

With Sheets("sheet1").Rows("1:" & lr)
.AutoFilter Field:=4, Criteria1:=ws.Name
.Offset(1).Copy Destination:=ws.Range("A2:L65000")
.AutoFilter
End With
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

"Sal" wrote:

I want to change this part of the macro €śFor Each ws In
ThisWorkbook.Worksheets€ť (I think) so that Sheet2, Sheet3, Sheet4, and Sheet5
will be excluded from the macro below. Can you tell me how I would do that?

Sub Separate ()
Sheets.Add.Name = "C"
Sheets.Add.Name = "I"
Sheets("sheet1").Activate
Range("A1:L1").Copy
Sheets("C").Activate
Range("A1").PasteSpecial
Sheets("I").Activate
Range("A1").PasteSpecial

Dim lr As Long
Dim ws As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "sheet1" Then
With Sheets("sheet1").Rows("1:" & lr)
.AutoFilter Field:=4, Criteria1:=ws.Name
.Offset(1).Copy Destination:=ws.Range("A2:L65000")
.AutoFilter
End With
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Don Guillett
Separate
 

One way that is easy for you to understand and adapt is

Sub ifnotsheets()
For Each ws In Worksheets
If ws.Name < "Sheet1" And _
ws.Name < "Sheet2" Then
MsgBox ws.Name
End If
Next
End Sub

You need some clean up here and I don't think you need to disable events.

Sub Separate ()'UNtested
Sheets.Add.Name = "C"
Sheets("sheet1").Range("A1:L1").Copy Range("A1")

Sheets.Add.Name = "I"
Sheets("sheet1").Range("A1:L1").Copy Range("A1")

Dim lr As Long
Dim ws As Worksheet

'Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "sheet2" and _
ws.Name < "sheet3" and _
ws.Name < "sheet4" and _
ws.Name < "sheet5" and _
ws.Name < "sheet6" and _
Then
With Sheets("sheet1").Rows("1:" & lr)
..AutoFilter Field:=4, Criteria1:=ws.Name
..Offset(1).Copy Destination:=ws.Range("A2:L65000")
..AutoFilter
End With
End If
Next ws
'Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Sal" wrote in message
...
I want to change this part of the macro €śFor Each ws In
ThisWorkbook.Worksheets€ť (I think) so that Sheet2, Sheet3, Sheet4, and
Sheet5
will be excluded from the macro below. Can you tell me how I would do
that?

Sub Separate ()
Sheets.Add.Name = "C"
Sheets.Add.Name = "I"
Sheets("sheet1").Activate
Range("A1:L1").Copy
Sheets("C").Activate
Range("A1").PasteSpecial
Sheets("I").Activate
Range("A1").PasteSpecial

Dim lr As Long
Dim ws As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "sheet1" Then
With Sheets("sheet1").Rows("1:" & lr)
.AutoFilter Field:=4, Criteria1:=ws.Name
.Offset(1).Copy Destination:=ws.Range("A2:L65000")
.AutoFilter
End With
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Don Guillett
Separate
 

Joel, Didn't see yours before I posted


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Don Guillett" wrote in message
...
One way that is easy for you to understand and adapt is

Sub ifnotsheets()
For Each ws In Worksheets
If ws.Name < "Sheet1" And _
ws.Name < "Sheet2" Then
MsgBox ws.Name
End If
Next
End Sub

You need some clean up here and I don't think you need to disable events.

Sub Separate ()'UNtested
Sheets.Add.Name = "C"
Sheets("sheet1").Range("A1:L1").Copy Range("A1")

Sheets.Add.Name = "I"
Sheets("sheet1").Range("A1:L1").Copy Range("A1")

Dim lr As Long
Dim ws As Worksheet

'Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "sheet2" and _
ws.Name < "sheet3" and _
ws.Name < "sheet4" and _
ws.Name < "sheet5" and _
ws.Name < "sheet6" and _
Then
With Sheets("sheet1").Rows("1:" & lr)
.AutoFilter Field:=4, Criteria1:=ws.Name
.Offset(1).Copy Destination:=ws.Range("A2:L65000")
.AutoFilter
End With
End If
Next ws
'Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Sal" wrote in message
...
I want to change this part of the macro €śFor Each ws In
ThisWorkbook.Worksheets€ť (I think) so that Sheet2, Sheet3, Sheet4, and
Sheet5
will be excluded from the macro below. Can you tell me how I would do
that?

Sub Separate ()
Sheets.Add.Name = "C"
Sheets.Add.Name = "I"
Sheets("sheet1").Activate
Range("A1:L1").Copy
Sheets("C").Activate
Range("A1").PasteSpecial
Sheets("I").Activate
Range("A1").PasteSpecial

Dim lr As Long
Dim ws As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "sheet1" Then
With Sheets("sheet1").Rows("1:" & lr)
.AutoFilter Field:=4, Criteria1:=ws.Name
.Offset(1).Copy Destination:=ws.Range("A2:L65000")
.AutoFilter
End With
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Sal
Separate
 
Thank you amico mio. This is very helpful to me.

"Joel" wrote:


Sub Separate ()
Sheets.Add.Name = "C"
Sheets.Add.Name = "I"
Sheets("sheet1").Activate
Range("A1:L1").Copy
Sheets("C").Activate
Range("A1").PasteSpecial
Sheets("I").Activate
Range("A1").PasteSpecial

Dim lr As Long
Dim ws As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets

If ws.Name < "sheet1" and _
ws.Name < "sheet2" and _
ws.Name < "sheet3" and _
ws.Name < "sheet4" and _
ws.Name < "sheet5" Then

With Sheets("sheet1").Rows("1:" & lr)
.AutoFilter Field:=4, Criteria1:=ws.Name
.Offset(1).Copy Destination:=ws.Range("A2:L65000")
.AutoFilter
End With
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

"Sal" wrote:

I want to change this part of the macro €śFor Each ws In
ThisWorkbook.Worksheets€ť (I think) so that Sheet2, Sheet3, Sheet4, and Sheet5
will be excluded from the macro below. Can you tell me how I would do that?

Sub Separate ()
Sheets.Add.Name = "C"
Sheets.Add.Name = "I"
Sheets("sheet1").Activate
Range("A1:L1").Copy
Sheets("C").Activate
Range("A1").PasteSpecial
Sheets("I").Activate
Range("A1").PasteSpecial

Dim lr As Long
Dim ws As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "sheet1" Then
With Sheets("sheet1").Rows("1:" & lr)
.AutoFilter Field:=4, Criteria1:=ws.Name
.Offset(1).Copy Destination:=ws.Range("A2:L65000")
.AutoFilter
End With
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub


-----------------------------------------------------------------------------
Less Spam Better enjoyable experience
Visit : news://spacesst.com

Sal
Separate
 
Thank you for the lesson friend. I appreciate your pointers and macro.
Thank you.

"Don Guillett" wrote:

One way that is easy for you to understand and adapt is

Sub ifnotsheets()
For Each ws In Worksheets
If ws.Name < "Sheet1" And _
ws.Name < "Sheet2" Then
MsgBox ws.Name
End If
Next
End Sub

You need some clean up here and I don't think you need to disable events.

Sub Separate ()'UNtested
Sheets.Add.Name = "C"
Sheets("sheet1").Range("A1:L1").Copy Range("A1")

Sheets.Add.Name = "I"
Sheets("sheet1").Range("A1:L1").Copy Range("A1")

Dim lr As Long
Dim ws As Worksheet

'Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "sheet2" and _
ws.Name < "sheet3" and _
ws.Name < "sheet4" and _
ws.Name < "sheet5" and _
ws.Name < "sheet6" and _
Then
With Sheets("sheet1").Rows("1:" & lr)
..AutoFilter Field:=4, Criteria1:=ws.Name
..Offset(1).Copy Destination:=ws.Range("A2:L65000")
..AutoFilter
End With
End If
Next ws
'Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Sal" wrote in message
...
I want to change this part of the macro €śFor Each ws In
ThisWorkbook.Worksheets€ť (I think) so that Sheet2, Sheet3, Sheet4, and
Sheet5
will be excluded from the macro below. Can you tell me how I would do
that?

Sub Separate ()
Sheets.Add.Name = "C"
Sheets.Add.Name = "I"
Sheets("sheet1").Activate
Range("A1:L1").Copy
Sheets("C").Activate
Range("A1").PasteSpecial
Sheets("I").Activate
Range("A1").PasteSpecial

Dim lr As Long
Dim ws As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
lr = Sheets("sheet1").Range("D" & Rows.Count).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
If ws.Name < "sheet1" Then
With Sheets("sheet1").Rows("1:" & lr)
.AutoFilter Field:=4, Criteria1:=ws.Name
.Offset(1).Copy Destination:=ws.Range("A2:L65000")
.AutoFilter
End With
End If
Next ws
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub




-----------------------------------------------------------------------------
Less Spam Better enjoyable experience
Visit : news://spacesst.com


All times are GMT +1. The time now is 09:52 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com