Daten Kopieren mit VBA klappt nur 1 mal

[thrustssc]

Hallo zusammen,

ich möchte gerne Daten aus einer Abfrage auf ein anderes Tabellenblatt(Archiv) kopieren und anschliessend die Duplikate entfernen.  Soweit so gut 1 mal klappt das. 
Beim 2. mal kommt ein Laufzeit Fehler 1004 weil keine gleiche Größe beim kopieren.

Sobald ich die Daten im Archiv komplett lösche funktioniert es wieder genau 1 mal. Ich find nur meinen Denkfehler nicht. Oder ich hab das zu kompliziert gemacht

Code:

Sub Kopieren()
    Dim lngErste As Long
    With Worksheets("Archiv") 'ziel
        lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
        Tabelle5.Range("c4:m" & Cells(Rows.Count, "m").End(xlDown).Row).Copy 'quelle
        .Cells(lngErste, 1).PasteSpecial Paste:=xlValues
    End With

Tabelle3.Range("A2:K300000").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

Und abschließend noch eine Frage zum Columns beim Remove.... ich hab das so verstanden das wenn ich 11 Spalten habe wie in meinem Falle muss da eine 11 rein damit alle 11 Spalten auf Duplicate überprüft werden. Funktioniert bei mir auch nur mit 1 bei 11 gehts nicht.

Wenn eine Datei benötigt wird reiche ich die nach kann nur die aktuelle Datei aus Datenschutzgründen nicht anhängen.

Vielen Dank schonmal im Voraus

[oee]

Der Pastebereich muss genau die selbe Anzahl von Spalten und Zeilen haben wie der Copybereich.

[Kuwer]

Hallo,

Code:

Sub Kopieren()
  Dim lngErste As Long
  Dim rngQ As Range
  Set rngQ = Tabelle5.Range("c4:m" & Cells(Rows.Count, 3).End(xlUp).Row)  'quelle
  With Worksheets("Archiv") 'ziel
    lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row + 1, .Rows.Count)
    If lngErste + rngQ.Rows.Count < Rows.Count Then
      rngQ.Copy
      .Cells(lngErste, 1).PasteSpecial Paste:=xlValues
    Else
      MsgBox "Zielbereich ist voll!"
    End If
  End With
  Tabelle5.Range("A2:K300000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11), Header:=xlNo
End Sub

Gruß, Uwe

[thrustssc]

Supi vielen Dank und schönes Wochenende