Erweiterung Kopieren
Michel
untenstehender Code funktioniert einwandfrei. Ich möchte dies nun erweitern.
Die so erstellen Zeilen der verschiedenen Tabellen einer Datei, sollten nun jeweils in eine eigene Datei weiter kopiert werden. Auch hier gilt es. Die letzte Zeile sollte nur dann kopiert werden, falls das Datum (1. Wert beider Zeilen in beiden Dokumenten) nicht schon enthalten ist. Dabei sollte die Datei, in die kopiert werden soll, automatisch geöffnet, gespeichert und geschlossen werden.
Grund für die Erweiterung: Es werden weitere Daten miteinbezogen, die im ersten Vorgang noch nicht enthalten sind.
Besten Dank für Eure Hilfe.
Gruss Michel
Sub KopierenNach(rngDatum As Range, rngWert As Range, shZiel As Worksheet)
Dim shQ As Worksheet, shD As Worksheet
Dim zeile As Long
zeile = -1
On Error Resume Next 'Fehler abfangen (wenn Datum nicht existiert)
zeile = WorksheetFunction.Match(rngDatum, shZiel.Columns(1), 0)
On Error GoTo 0
If zeile = -1 Then zeile = shZiel.Cells(shZiel.Rows.Count, 1).End(xlUp).Row + 1
With shZiel
.Cells(zeile, 1) = rngDatum
.Cells(zeile, 2) = rngWert
End With
End Sub
Sub Test()
KopierenNach Worksheets("Tabelle1").Range("A1"), Worksheets("Tabelle1").Range("B1"), Worksheets( _
_
"Tabelle2")
KopierenNach Worksheets("Tabelle1").Range("A2"), Worksheets("Tabelle1").Range("B2"), Worksheets( _
_
"Tabelle3")
End Sub