Mehrer Zellen in ein anderes Arbeitsblatt kopieren

[Help123]

Hallo, (ich benutze Office 10)
mein Ziel ist es eine Zeile von einem Arbeitsblatt in ein anderes zu kopieren ( mit einer Bedingung hier ist in Spalte F2 etwas eingetragen)
So habe ich es veranlasst.

Option Explicit
Sub Kopieren()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Set ws1 = Worksheets("alle")
Set ws2 = Worksheets("Herr X")
Set ws3 = Worksheets("Herr Y")

ws1.Range("F2").AutoFilter Field:=6, Criteria1:="Herr X"
ws1.Range("3:" & ws1.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy ws2.Range("3:" & ws2.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
ws1.Range("F2").AutoFilter
ws1.Range("F2").AutoFilter Field:=6, Criteria1:="Herr Y"
ws1.Range("3:" & ws1.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy ws3.Range("3:" & ws3.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
ws1.Range("F2").AutoFilter


Nun möchte ich aber nur die Spalten A bis E kopieren mehr nicht, wo und wie muss ich diese Bedingung einbauen?
Und wie gewährleiste ich, dass keine Zellen am Ende doppelt vorhanden sind?

Danke schonmal
Gruß

 

[Spike S.]

Wenn du nur A3 bis EX kopieren willst, setz einfach die Range entsprechend. Beim Ziel sollte es auch reichen, die erste Zelle anzugeben.

ws1.Range("A3:E" & ws1.UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy ws2.Range("A" & ws2.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)

Das simpelste, doppelte Einträge zu vermeiden, ist vorher alles aus den Zieltabellen zu löschen. Wenn das keinen Sinn macht in deinem Fall oder schon doppelte in den Quelltabellen sind, bleibt nur die Spalte(n) mit einer Schleife zu durchlaufen und zu vergleichen.

Zusätzlich solltest du vielleicht vorher noch prüfen, ob nach dem Autofilter noch was zum kopieren übrig geblieben ist. Leere Bereiche kopieren macht keinen Sinn und verursacht im Zweifel unnötige Fehler.

Gruß
Spike

 

[Help123]

Danke für deine Hilfe