Dim sh as worksheet
dim cell as range, rng as Range
On Error Resume Next
set sh = worksheets("Melden landelijke dd" & format(Date,"yyyymmdd"))
On Error goto 0
if sh is nothing then
set sh = worksheets.Add(After:=worksheets(worksheets.count) )
sh.name = "Melden landelijke dd" & format(Date,"yyyymmdd")
End if
With Sheets("Inschrijvingen")
.rows(1).copy Destination:=sh.Range("A1")
' use column A to determine the extent of the data
set rng = Range(Cells(2,1),cells(rows.count,1).End(xlup))
set rng = rng.offset(0,13)
for each cell in rng
If cell.Value = "Nee" Or _
cell.Value = "N" Then
cell.entirerow.copy _
Destination:=sh.Cells(rows.count,1).End(xlup)(2)
end if
Next
End With

Change the format command to format the date as you want it to appear in the
name.

--
Regards,
Tom Ogilvy


"hans" wrote in message
...
Thank Tom.
It was late lastnight when i made this message.
What i am trying to do is do copy all record het in het 14 collumn te
answer
is no to a new sheet with has the name "Melden landelijke dd " & Date"
Greetings Hans

"Tom Ogilvy" schreef in bericht
...
Try not selecting:

With Sheets("Inschrijvingen")
.Rows("1:1").Copy
set rng = .Range("A1")
Do While Not IsEmpty(rng)
If rng.Offset(0, 13).Value = "Nee" Or _
rng.Offset(0,13).Value = "N" Then
If Not SheetExists("Melden landelijke dd " & Date) Then
Worksheets.Add.Move After:=Worksheets(Worksheets.Count)
Set CurSheet = ActiveSheet
CurSheet.Name = "Melden landelijke dd " & Date
CurSheet.Range("A1").PasteSpecial xlPasteAll
Sheets("Inschrijvingen").Activate
End If
End if
'copy what i need and go on
Loop
End With

Not sure the above accomplishes what you want because your original code
didn't seem to do much - but I believe the above will do what your
original
code was doing without selecting.

--
Regards,
Tom Ogilvy

hans wrote in message
...
I use the following macro:

Sheets("Inschrijvingen").Select
Rows("1:1").Select
Selection.Copy
Range("a1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
If ActiveCell.Offset(0, 13).Value = "Nee" Or
ActiveCell.Offset(0,13).Value = "N" Then
If Not SheetExists("Melden landelijke dd " & Date) Then
Worksheets.Add.Move
After:=Worksheets(Worksheets.Count)
Set CurSheet = ActiveSheet
CurSheet.Name = "Melden landelijke dd " & Date
Range("A1").Select *************
ActiveSheet.Paste *************
Sheets("Inschrijvingen").Select
End If
'copy what i need and go on
ActiveCell.Offset(1, 0).Select
Loop

I get an error on the line with the **********
What am i doing wrong?

Greetings Hans