Übertragung von aktuellen Datensätzen
03.12.2020 15:00:27
aktuellen
ich habe folgendes Problem, dass ich nicht lösen konnte:
Ich habe zwei Excel-Dateien.
Jede Datei hat eine Tabelle mit einer Spalte, in denen ein Datum mit Uhrzeit (03.12.2020 11:11) hinterlegt sind. Aus der Datei_1 sollen alle aktuellen Datensätze Ab Spalte F in Date_2 übertragen werden.
Aktuell kann alle Datensätze mit folgendem Code von Datei_1 in Datei_2 übertragen. Jedoch werden alle Datensätze übertragen. Ich möchte nur die aktuellen Datensätze die aktueller sind als der erste Datensatz in Datei_2.
Über meinen Code kann Datei_2 Datei_1 über ein Dialogfenster die Datensätze kopieren.
Die neuen Datensätze aus Datei_1 sollen dann eine neue Zeile sortiert mit dem aktuellen Datum (absteigend) hinzugefügt werden.
Hier ein kleines Beispiel wie es aussehen soll:
Vorher:
Datei_1:
A B C
Name Alter 03.12.2020 11:11
Name Alter 01.12.2020 11:00
Name Alter 01.12.2020 10:00
Datei_2:
F G H
Name Alter 01.12.2020 10:00
Name Alter 30.11.2020 09:00
Name Alter 30.11.2020 08:11
Nachher:
Datei_1:
A B C
Name Alter 03.12.2020 11:11
Name Alter 01.12.2020 11:00
Name Alter 01.12.2020 10:00
Datei_2:
F G H
Name Alter 03.12.2020 11:11
Name Alter 01.12.2020 11:00
Name Alter 01.12.2020 10:00
Name Alter 30.11.2020 09:00
Name Alter 30.11.2020 08:11
Anbei mein Code:
Option Explicit
Sub OeffnenDialog_mit_Pfadvorgabe()
'** Anzeige des Öffnen-Dialogfensters mit voreingestelltem Pfad
'** Dimensionierung der Variablen
Dim lshThis As Worksheet, lshOther As Worksheet
Dim wb As Workbook
Dim lngZ As Long
Dim strFileName
Dim strFilter As String
'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xl*), *.xl*"
'** Laufwerk und Pfad definieren, welcher geöffnet werden soll
ChDrive "C"
ChDir "C:\Projekt"
'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)
'** Prüfen, ob eine gültige Datei ausgewählt wurde
If strFileName = False Then Exit Sub
'** Gewählte Datei öffnen
Set wb = Workbooks.Open(strFileName)
'**Erste Registerkarte wird ausgelesen und in die erste Registerkarte abgelegt
Set lshThis = ThisWorkbook.Sheets(1)
Set lshOther = ActiveWorkbook.Sheets(1)
'**Inhalt der Zellen A1: bis O500 wird kopiert und in F1 eingefügt
lshOther.Range("A1:O500").Copy lshThis.Range("F1")
ActiveWorkbook.Close False
End Sub