[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