farbige Zellen in neues Tabellenblatt kopieren

Sub übrige_Namen() Dim c As Range
Dim WS1 As Worksheet
Dim WS3 As Worksheet
Set WS1 = Workbooks("Daten.xls").Sheets(1)
Set WS3 = Workbooks("Neue Daten.xls").Sheets(1)
WS1.Range("C2:C" & ActiveSheet.Range("C65536").End(xlUp).Row + 1).Select
For Each c In Selection
If c  Empty And c.Interior.ColorIndex  7 Then
c.Copy
WS3.Range("B2:B" & ActiveSheet.Range("B65536").End(xlUp).Row).Insert
End If
Next
End Sub

Es erscheinen dann zwar die unfarbigen Zellen in der neuen Datei, aber nicht nur einmal sondern so oft, wie viele Zeilen das ursprüngliche Tabellenblatt, aus dem die Zellen kopiert wurden, hat.
Kann mir vielleicht irgendjemand einen Tip geben?
Danke schonmal!
Viele Grüße
Franziska