[E-on]

Sub Copytom()
Dim rng As Range, i As Long, ws As Worksheet, sh As Worksheet

For Each ws In Worksheets
On Error Resume Next
If sh.Name = "New" Then sh.Delete
If sh.Name < "New" Then
Set sh = Sheets.Add
sh.Name = "New"
End If
For i = 3 To 100
If ws.Cells(i, 5).Value = " Stockwell Motors" Then
ws.Range("F" & i & ":G" & i).Copy Worksheets("New").Range("A" & _Rows.Count).End(xlUp).Offset(1, 0)
End If
Next
Next
End Sub

This is my second post on this forum. I had found a solution for my first post and hopefully to get for a second post too.

I am really mystified by the above code. Let me explain line by line. It is not my code, got it from someone.

For Each ws In Worksheets ‘to loop through each sheet

If sh.Name = "New" Then sh.Delete ‘ if sheet name “new” does exist delete it and it does not create a new one
If sh.Name < "New" Then
Set sh = Sheets.Add
sh.Name = "New"
For i = 3 To 100 ‘ loop through from row 3 to row 100
If ws.Cells(i, 5).Value = " Stockwell Motors" Then
‘ in each worksheet of each row of column E, look for Stockwell motors
And the last line is to copy column F and G of row which has Stockwell motors in to the new created sheet.

I understand all lines, but lost as to why the code creates 97 blank sheets instead of coping rows in to the new sheet. What is wrong with the code? Why the code is not doing what is supposed to do. Please help.


Basically, I have many sheets. They all have the same number of rows and column numbers, hence I set up rng as Set rng = ws.Range("A3:R100"). Where I am stuck is when I try to loop through each cell in column "E" of ws.Range("A3:R100"). If any cell in each sheet of column "E" has a name “Stockwell Motors", then copy, but I am stuck. i am sure these lines are wrong .

[Bob Flanagan[_4_]]

Interesting question :). It took a moment

When your code first runs, "sh" is not set to a worksheet, it is
"nothing"

so, the statement "sh.name ="new" then sh.delete" will not do anthing

And the IF statement will always run the next statement as you have
"on error resume next" set on (a bad idea :) )

So, it will create a new worksheet. I suspect you have many
worksheets in your workbook. So the loop will create many worksheets,
as sh never gets set to anything.

Hopefully this gives you the clue to solve.

If you want to delete a sheet named "new" then do this:

On error resume next
application.displayalerts = false
Worksheets("new").delete
application.displayalerts = true
On error goto 0

Lots of other ways:

on error resume next
set sh = worksheets("new")
if not sh is nothing then
application.displayalerts = false
sh.delete
application.displayalerts = false
end if
on error goto 0

Robert Flanagan
Add-ins.com LLC
http://www.add-ins.com
Productivity add-ins and downloadable books on VB macros for Excel



On Jun 5, 9:34*am, E-on wrote:
Sub Copytom()
Dim rng As Range, i As Long, ws As Worksheet, sh As Worksheet

For Each ws In Worksheets
On Error Resume Next
If sh.Name = "New" Then sh.Delete
If sh.Name < "New" Then
Set sh = Sheets.Add
sh.Name = "New"
End If
For i = 3 To 100
If ws.Cells(i, 5).Value = " Stockwell Motors" Then
ws.Range("F" & i & ":G" & i).Copy
Worksheets("New").Range("A" & *_Rows.Count).End(xlUp).Offset(1, 0)
End If
Next
Next
End Sub

This is my second post on this forum. I had found a solution for my
first post and hopefully to get for a second post too.

I am really mystified by the above code. Let me explain line by line. It
is not my code, got it from someone.

For Each ws In Worksheets to loop through each sheet

If sh.Name = "New" Then sh.Delete if sheet name new does exist
delete it and it does not create a new one
If sh.Name < "New" Then
Set sh = Sheets.Add
sh.Name = "New"
For i = 3 To 100 loop through from row 3 to row 100
If ws.Cells(i, 5).Value = " Stockwell Motors" Then
in each worksheet of each row of column E, look for Stockwell motors
And the last line is to copy column F and G of row which has Stockwell
motors in to the new created sheet.

I understand all lines, but lost as to why the code creates 97 blank
sheets instead of coping rows in to the new sheet. What is wrong with
the code? Why the code is not doing what is supposed to do. Please
help.

Basically, I have many sheets. They all have the same number of rows and
column numbers, hence I set up rng as Set rng = ws.Range("A3:R100").
Where I am stuck is when I try to loop through each cell in column "E"
of ws.Range("A3:R100"). If any cell in each sheet of column "E" has a
name Stockwell Motors", then copy, but I am stuck. i am sure these
lines are wrong .

--
E-on

[Claus Busch]

Hi E-on,

Am Tue, 5 Jun 2012 13:34:59 +0000 schrieb E-on:

Sub Copytom()
Dim rng As Range, i As Long, ws As Worksheet, sh As Worksheet

For Each ws In Worksheets
On Error Resume Next
If sh.Name = "New" Then sh.Delete
If sh.Name < "New" Then
Set sh = Sheets.Add
sh.Name = "New"
End If
For i = 3 To 100
If ws.Cells(i, 5).Value = " Stockwell Motors" Then
ws.Range("F" & i & ":G" & i).Copy
Worksheets("New").Range("A" & _Rows.Count).End(xlUp).Offset(1, 0)
End If
Next
Next
End Sub

why you want to loop through 100 rows? You can filter and copy the
visible cells in sheet "New". What's the name of ws? In following code I
set ws = worksheets("Overview") - change it to your really name:

Sub Copytom()
Dim rng As Range, i As Long, ws As Worksheet
Dim sh As Worksheet, LRow As Long

On Error Resume Next
Set sh = Worksheets("New")
If Not sh Is Nothing Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = False
End If

Set sh = Sheets.Add
sh.Name = "New"

Set ws = Worksheets("Overview")
With ws
..Range("A2").AutoFilter Field:=5, Criteria1:= _
"Stockwell Motors"
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
..Range("F3:G" & LRow).Copy _
Worksheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
..AutoFilterMode = False
End With

End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

[E-on]

Bob Flanagan! You are spot on! The code was given to me by some one. The reason for mylikeness of the code is that of simplcity. I have seen many similar solutions using Filter, as newbie to VBA, I struggle to understand and remeber the code, so I would prefer loops.

Basically, I have 12 sheets, each sheet has the same number of rows and columns. I would like the code to look in the range of A3-R100 of each sheet of column E, which has names of vendors. So, if the code finds the vendor name- stockwell motors in each sheet between rows of 3- 100 of column E, it should copy that row in to new sheet. So, the new sheet should only have data for stock well motors. I know it may be easy to use filter, but I wonder if the same result can be achieved using a loop, and how one can correct my code to have the same result as a filter?

Thnaks for your help

Originally Posted by Bob Flanagan[_4_]

Interesting question :). It took a moment

When your code first runs, "sh" is not set to a worksheet, it is
"nothing"

so, the statement "sh.name ="new" then sh.delete" will not do anthing

And the IF statement will always run the next statement as you have
"on error resume next" set on (a bad idea :) )

So, it will create a new worksheet. I suspect you have many
worksheets in your workbook. So the loop will create many worksheets,
as sh never gets set to anything.

Hopefully this gives you the clue to solve.

If you want to delete a sheet named "new" then do this:

On error resume next
application.displayalerts = false
Worksheets("new").delete
application.displayalerts = true
On error goto 0

Lots of other ways:

on error resume next
set sh = worksheets("new")
if not sh is nothing then
application.displayalerts = false
sh.delete
application.displayalerts = false
end if
on error goto 0

Robert Flanagan
Add-ins.com LLC
http://www.add-ins.com
Productivity add-ins and downloadable books on VB macros for Excel



On Jun 5, 9:34*am, E-on wrote:
Sub Copytom()
Dim rng As Range, i As Long, ws As Worksheet, sh As Worksheet

For Each ws In Worksheets
On Error Resume Next
If sh.Name = "New" Then sh.Delete
If sh.Name < "New" Then
Set sh = Sheets.Add
sh.Name = "New"
End If
For i = 3 To 100
If ws.Cells(i, 5).Value = " Stockwell Motors" Then
ws.Range("F" & i & ":G" & i).Copy
Worksheets("New").Range("A" & *_Rows.Count).End(xlUp).Offset(1, 0)
End If
Next
Next
End Sub

This is my second post on this forum. I had found a solution for my
first post and hopefully to get for a second post too.

I am really mystified by the above code. Let me explain line by line. It
is not my code, got it from someone.

For Each ws In Worksheets to loop through each sheet

If sh.Name = "New" Then sh.Delete if sheet name new does exist
delete it and it does not create a new one
If sh.Name < "New" Then
Set sh = Sheets.Add
sh.Name = "New"
For i = 3 To 100 loop through from row 3 to row 100
If ws.Cells(i, 5).Value = " Stockwell Motors" Then
in each worksheet of each row of column E, look for Stockwell motors
And the last line is to copy column F and G of row which has Stockwell
motors in to the new created sheet.

I understand all lines, but lost as to why the code creates 97 blank
sheets instead of coping rows in to the new sheet. What is wrong with
the code? Why the code is not doing what is supposed to do. Please
help.

Basically, I have many sheets. They all have the same number of rows and
column numbers, hence I set up rng as Set rng = ws.Range("A3:R100").
Where I am stuck is when I try to loop through each cell in column "E"
of ws.Range("A3:R100"). If any cell in each sheet of column "E" has a
name Stockwell Motors", then copy, but I am stuck. i am sure these
lines are wrong .

--
E-on

[E-on]

claus! Thanks for your help.
If my understanding is correct. This below only applies to "Overview" Sheet. But as I just explained to Bob, I have 12 sheets.

Set ws = Worksheets("Overview")

Originally Posted by Claus Busch

Hi E-on,

Am Tue, 5 Jun 2012 13:34:59 +0000 schrieb E-on:

Sub Copytom()
Dim rng As Range, i As Long, ws As Worksheet, sh As Worksheet

For Each ws In Worksheets
On Error Resume Next
If sh.Name = "New" Then sh.Delete
If sh.Name < "New" Then
Set sh = Sheets.Add
sh.Name = "New"
End If
For i = 3 To 100
If ws.Cells(i, 5).Value = " Stockwell Motors" Then
ws.Range("F" & i & ":G" & i).Copy
Worksheets("New").Range("A" & _Rows.Count).End(xlUp).Offset(1, 0)
End If
Next
Next
End Sub

why you want to loop through 100 rows? You can filter and copy the
visible cells in sheet "New". What's the name of ws? In following code I
set ws = worksheets("Overview") - change it to your really name:

Sub Copytom()
Dim rng As Range, i As Long, ws As Worksheet
Dim sh As Worksheet, LRow As Long

On Error Resume Next
Set sh = Worksheets("New")
If Not sh Is Nothing Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = False
End If

Set sh = Sheets.Add
sh.Name = "New"

Set ws = Worksheets("Overview")
With ws
..Range("A2").AutoFilter Field:=5, Criteria1:= _
"Stockwell Motors"
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
..Range("F3:G" & LRow).Copy _
Worksheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
..AutoFilterMode = False
End With

End Sub


Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

[Claus Busch]

Hi E-on

Am Tue, 5 Jun 2012 20:32:57 +0000 schrieb E-on:

If my understanding is correct. This below only applies to "Overview"
Sheet. But as I just explained to Bob, I have 12 sheets.

now it's working with each sheet of your workbook:

Sub Copytom()
Dim rng As Range, i As Long, ws As Worksheet
Dim sh As Worksheet, LRow As Long

On Error Resume Next
Set sh = Worksheets("New")
If Not sh Is Nothing Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = False
End If

Set sh = Sheets.Add
sh.Name = "New"

For Each ws In Worksheets
With ws
If ws.Name < "New" Then
.Range("A2").AutoFilter Field:=5, Criteria1:= _
"Stockwell Motors"
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("F3:G" & LRow).Copy _
Worksheets("New").Range("A" & _
Rows.Count).End(xlUp).Offset(1, 0)
.AutoFilterMode = False
End If
End With
Next

End Sub

Regards
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2