many thanks.

"J.E. McGimpsey" wrote in message
...
One way:

Replace

If Intersect(rng, .Columns(2)).SpecialCells( _
xlCellTypeVisible).Count 1 Then _
Intersect(rng, .Range("C2:C65532")).Copy _
Destination:=cell.Offset(3, 0)


with


If Intersect(rng, .Columns(2)).SpecialCells( _
xlCellTypeVisible).Count 1 Then
Intersect(rng, .Range("C2:C65532")).Copy _
Destination:=cell.Offset(3, 0)
cell.Offset(1, 0).Value = Application.CountA( _
cell.Offset(3, 0).Resize(65532, 1))
End If

In article ,
"Gareth" wrote:

Thanks very much for this, it does exactly what I want it to. Apologies
if
I didn't explain everything but it would appear you understood my main
aim.

I have forgotten one bit, after the copy and paste onto sheet1 I want to
count the number of records and put it into cell.Offset(1,0)

Hope you can help.

Gareth
"J.E. McGimpsey" wrote in message
...
I don't understand a bit about what you're doing (see below), but
this will cycle A2:G2:

Public Sub CheckDates()
Dim cell As Range
Dim d1Cell As Range
Dim rng As Range

With Worksheets("Sheet2")
Set d1Cell = .Range("D1")
For Each cell In Worksheets("Sheet1").Range("A2:G2")
If Not IsEmpty(cell.Value) Then
d1Cell.Value = cell.Value
.Range("B1").AutoFilter _
field:=4, Criteria1:="=6"
Set rng = .AutoFilter.Range
If Intersect(rng, .Columns(2)).SpecialCells( _
xlCellTypeVisible).Count 1 Then _
Intersect(rng, .Range("C2:C65532")).Copy _
Destination:=cell.Offset(3, 0)
IN HERE
.Range("B1").AutoFilter field:=4
End If
Next cell
End With
End Sub