Sub makro()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim RngCell As Range
Dim nettingList() As Variant
Dim res As Variant
'Set wks = .Worksheets("wejscia T")
nettingList() = Array("UK", "GE", "FR", "IT", "SP", "HK", _
"US", "INT", "IRL", "CZ", "JP")
With Workbooks(ActiveWorkbook.Name)
Set wsA = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
Set wsB = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
wsA.Name = "wejscia T netting"
wsB.Name = "wejscia T outnet"
With .Worksheets("wejscia T Avon 2005")
.Rows(1).Copy Destination:=wsA.Range("A1")
.Rows(1).Copy Destination:=wsB.Range("A1")
For Each RngCell In .Range("C2:C" & .Range("C" &
.Rows.Count).End(xlUp).Row)
res = Application.Match(RngCell.Value, nettingList)
If IsError(res) Then
With wsB
RngCell.EntireRow.Copy Destination:= _
.Range("A" & .Rows.Count).End( _
xlUp).Offset(1, 0)
End With
Else
With wsA
RngCell.EntireRow.Copy Destination:= _
.Range("A" & .Rows.Count).End( _
xlUp).Offset(1, 0)
End With
End If
Next RngCell
End With
End With
End Sub

--
Regards,
Tom Ogilvy

"Przemek" wrote in message
oups.com...
Hi, I'm trying to copy rows to 2 others sheets, looping through cells
if cell value match with one of array value. But it copies all rows. It
seems, that application.match doesn't work properly.

My code:

Sub makro()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim RngCell As Range
Dim nettingList() As Variant
Dim res As Variant
'Set wks = .Worksheets("wejscia T")
nettingList() = Array("UK", "GE", "FR", "IT", "SP", "HK", _
"US", "INT", "IRL", "CZ", "JP")
With Workbooks(ActiveWorkbook.Name)
Set wsA = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
Set wsB = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
wsA.Name = "wejscia T netting"
wsB.Name = "wejscia T outnet"
With .Worksheets("wejscia T Avon 2005")
.Rows(1).Copy Destination:=wsA.Range("A1")
.Rows(1).Copy Destination:=wsB.Range("A1")
For Each RngCell In .Range("C2:C" & .Range("C" &
.Rows.Count).EndxlUp).Row)
res = Application.WorksheetFunction.Match(RngCell.Value, nettingList)
If IsError(res) Then
With wsB
RngCell.EntireRow.Copy Destination:= _
.Range("A" & .Rows.Count).End( _
xlUp).Offset(1, 0)
End With
Else
With wsA
RngCell.EntireRow.Copy Destination:= _
.Range("A" & .Rows.Count).End( _
xlUp).Offset(1, 0)
End With
End If
Next RngCell
End With
End With
End Sub

How should I use Application.Match function to correct this?

Przemek