Excel 2000 VBA Matching Value problem

[grego9]

I have a bit of visual basic code in an excel spreadsheet that I need some help with. I am attempting to search a file called TO Cancellations2. xls for counterparty names and for each counterparty name that it finds that matches the list of counterparties on the "counterparties " sheet of a file called Time Option Template WIP.xls I want the whole line copied and pasted into a new excel worksheet that should have the counterparty name and then FXTOX.xls after it.

The TO Cancellation2.x ls file looks like this

Counterparty
Oy AB 109385 H2 07
Oy AB 109389 H1 08
Oy AB 109390 H2 08
Oy AB 109387 H2 07
Oy AB 109388 H1 08
AB (Sweden) 109391 H2 08

The code below works ok but if the TO Cancellations2. xls file has the same counterparty more than once (as in this case with 5 different records against Oy AB) then instead of saving all 5 records into one file it overwrites the file each time with each of these 5 instances - only keeping the last record. Can anyone suggest any ideas on how to alter this code so that if there is more than one row countaining the same counterparty name it saves all of the rows to the same file and doesn't keep overwriting like it is currently doing?


Sheets("Counter parties").Selec t

' Initialise Counter
Countz = 0
For Each c In Range("A1:A100" )
If c.Value = "" Then
Exit For
Else
Countz = Countz + 1
End If
Next c

Sheets("Data2") .Select (NB data2 is a sheet in the Time Option Template WIP.xls file)
Range("A1").Sel ect

For Counter = 1 To Countz

Set Matching = Worksheets("Cou nterparties").C ells(Counter, 1)
Set Matching2 = Worksheets("Cou nterparties").C ells(Counter + 1, 1)
Set Matching3 = Worksheets("Cou nterparties").C ells(Counter + 2, 1)
Set Matching4 = Worksheets("Cou nterparties").C ells(Counter + 3, 1)
Set Matching5 = Worksheets("Cou nterparties").C ells(Counter + 4, 1)
Set Matching6 = Worksheets("Cou nterparties").C ells(Counter + 5, 1)
Set Matching7 = Worksheets("Cou nterparties").C ells(Counter + 6, 1)

For Each c In Range("A1:A5001 ")

If c.Value = Matching.Value Then
If c.Offset(0, 0).Value = Matching2.Value Or c.Offset(0, 0).Value = Matching3.Value Or c.Offset(0, 0).Value = Matching4.Value Or c.Offset(0, 0).Value = Matching5.Value Or c.Offset(0, 0).Value = Matching6.Value Or c.Offset(0, 0).Value = Matching7.Value Then
Else
c.EntireRow.Sel ect
Selection.Copy
Workbooks.Add
ActiveSheet.Pas te
Cells(2, 1).Select
stdocname = "Q:\Dealing Room\Dealing room administration\ Admin Things\Batch Report Masters\Outputs \" & Matching.Value & " FXTOX.xls"
ActiveWorkbook. SaveAs Filename:=stdoc name _
, FileFormat:=xlN ormal, Password:="", WriteResPasswor d:="", _
ReadOnlyRecomme nded:=False, CreateBackup:=F alse
Windows("Time Option Template WIP.xls").Activ ate
stdocname = Matching.Value & " FXTOX.xls"
Counti = 2
Do Until c.Offset(Counti , 0).Value = Matching2 Or c.Offset(Counti , 0).Value = Matching3 Or c.Offset(Counti , 0).Value = Matching4 Or c.Offset(Counti , 0).Value = Matching5 Or c.Offset(Counti , 0).Value = Matching6 Or c.Offset(Counti , 0).Value = Matching7 Or c.Offset(Counti , 0).Value = "Contact RG"
c.Offset(Counti , 0).EntireRow.Se lect
Selection.Copy
Windows(stdocna me).Activate
Cells(Counti + 1, 1).Select
ActiveSheet.Pas te
Windows("Time Option Template WIP.xls").Activ ate
Counti = Counti + 1
Loop