Stuart

sorry, I can't follow your code. That said, can you not just test each of
the three conditions and set a variable, say CopyFlag. Then, if the
CopyFlag is set, copy the record set.

In pseudo code:

Dim CopyFlag As Boolean
CopyFlag = False
If "Condition 1" is True Then CopyFlag = True
If "Condition 2" is True Then CopyFlag = True
If "Condition 3" is True Then CopyFlag = True
If CopyFlag Then "copy recordset

Thought you'd solved this problem once?

Regards

Trevor


"Stuart" wrote in message
...
Sample data to be copied:

X Data............. 5 no 25 125 T Y D
more data
more etc

Data is in a single row (wraptext is enabled) and occupies
cols A:F.
T, Y and D are in cols G:I and are user's 'tags', indicating
to which sheet (in a different book) the recordset is to be
copied.

Here's the problem, as faithfully as I am able to explain it:

In general if only T were present, then I'd get one paste
into sheet(T). If T and Y are present, then I'm getting
2 records pasting into both sheets T and Y. etc.
This is not 100% consistent, however, but indicative,
nevertheless.

Here is the Copy/Paste sequence:

For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select 'for now
.Unprotect
LastRow = Application.Max(.Cells(Rows.Count, £Col + 2) _
.End(xlUp).Row, .Cells(Rows.Count, £Col + 3) _
.End(xlUp).Row, _
.Cells(Rows.Count, £Col + 4).End(xlUp).Row)
If LastRow 1 Then
Set DataRange = .Range(.Cells(2, £Col + 2), _
.Cells(LastRow, £Col + 4))
For Each Cell In DataRange.SpecialCells(xlConstants)
If Not IsEmpty(Cell) Then
If .Range("A" & Cell.Row).End(xlUp).Value = "Item" Then
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0,
1).End(xlDown).Row
Else
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).End(xlDown).Row
End If

'For normal BofQ's use
EndCopyRow = Cell.Row

.Range("A" & StartCopyRow, .Cells(EndCopyRow, _
£Col + 4)).Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls") .Worksheets _
(Cell.Value).Cells(Rows.Count, 3).End(xlUp) _
.Offset(2, -1)
If Not IsEmpty(.Cells(StartCopyRow, £Col).End +
(xlDown).Offset(-1, 1 - £Col)) Then
.Cells(StartCopyRow, £Col).End(xlDown).Offset _
(-1, 1 - £Col) .Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls").Worksheets _
(Cell.Value).Range("B65536").End(xlUp).Offset(0, -1)
End If
End If
Next
End If
End With
End If
Next

I've tried everything I can think of over the last few days, including
a column by column copy and paste, copying and pasting just one
tag value at a time, etc....to no avail.....basically very similar
duplicate copies occur.

If the problem is not apparent, then I have a small workbook with
code, if anyone would be prepared to accept an attachment.

It's holding up some serious work, hence my repost and the time
I'm spending on it, so help would be most welcome.

Regards.



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003