Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1740to1744
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

2 Dateien - Werte bedingt kopieren

2 Dateien - Werte bedingt kopieren
25.02.2020 11:48:10
Enno
Hallo zusammen
Ich benötige dringend eure Unterstützung. Denn trotz intensiver Recherche konnte ich für meine Aufgabenstellung leider nichts Passendes finden.
Worum geht es:
1.) Ich habe auf der einen Seite die Quelldatei und auf der anderen Seite die Zieldatei = Zusammenfassung aller Quelldateien.
2.) Der Pfad und Name der Quelldatei ist unterschiedlich, da es mehrere davon gibt. Der Pfad und Name der Zieldatei ist fix da nur eine Zieldatei exisitert.
3.) Der Name der Tabelle in der Quelldatei ist stets fix, ebenso der Name der Tabelle in der Zieldatei.
4.) Durch Click auf einen Command Button in der Tabelle der Quelldatei soll, alles unsichtbar, ...
a) zuerst die Zieldatei geöffnet und die dazugehörige relevante Tabelle angewählt werden.
b) danach der Inhalt der Zelle M2 aus der Tabelle der Quelldatei in der Spalte A der Tabelle der Zieldatei gesucht werden.
c) wenn der Inhalt gemäss b) gefunden wird, sollen in die entsprechende Zeile der Tabelle der Zieldatei, in der sich in der Spalte A der gefundene Wert befindet, folgende Inhalte kopiert werden:
- Zellinhalt C7 aus Tabelle Quelldatei in Zelle Spalte B der o.g. Zeile in Tabelle Zieldatei
- Zellinhalt C8 aus Tabelle Quelldatei in Zelle Spalte D der o.g. Zeile in Tabelle Zieldatei
- Zellinhalt N23 aus Tabelle Quelldatei in Zelle Spalte E der o.g. Zeile in Tabelle Zieldatei
- usw...
d) wenn der Inhalt gemäss b) nicht gefunden wird, sollen die unter c) genannten Kopiervorgänge in der ersten leeren Zeile unterhalb Zeile 9 der Tabelle Zieldatei (Kriterium = Zelle in Spalte A = leer) erfolgen.
e) nach Abschluss der Kopiervorgänge soll die Zieldatei gespeichert und geschlossen werden.
Schon jetzt ein grosses Dankeschön für eure Hilfe.

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: 2 Dateien - Werte bedingt kopieren
25.02.2020 12:16:41
Torsten
Hallo Enno,
z.B. so:
bitte anpassen, was anzupassen ist:

Option Explicit
Sub oeffnen_kopieren()
Dim wbQuelle As Workbook, wbZiel As Workbook
Set wbQuelle = ThisWorkbook
Dim strPfadZiel As String
strPfadZiel = "C:\MeinPfad\Zieldatei.xlsx"      'Pfad und Dateiname anpassen
Dim wsQuelle As String, wsZiel As String
wsQuelle = wbQuelle.Sheets("Quellsheet")        'Sheetname anpassen
Workbooks.Open (strPfadZiel)
Set wbZiel = ActiveWorkbook
wsZiel = wbZiel.Sheets("Zielsheet")             'Sheetname anpassen
Dim Suchwert As Variant
Dim Suchzeile As Long, LetzteZeile As Long
LetzteZeile = wsZiel.Cells(Rows.Count, 1).End(xlUp).Row
Set Suchwert = wsZiel.Range("A1:A" & LetzteZeile).Find(wsQuelle.Range("M2"), LookIn:=xlValues,  _
lookat:=xlWhole)
If Not Suchwert Is Nothing Then
Suchzeile = Suchwert.Row
wsZiel.Cells(Suchzeile, 2) = wsQuelle.Cells(7, 3)
wsZiel.Cells(Suchzeile, 4) = wsQuelle.Cells(8, 3)
wsZiel.Cells(Suchzeile, 5) = wsQuelle.Cells(23, 14)
Else
LetzteZeile = wsZiel.Cells(Rows.Count, 1).End(xlUp).Row
wsZiel.Cells(LetzteZeile + 1, 2) = wsQuelle.Cells(7, 3)
wsZiel.Cells(LetzteZeile + 1, 4) = wsQuelle.Cells(8, 3)
wsZiel.Cells(LetzteZeile + 1, 5) = wsQuelle.Cells(23, 14)
End If
wbZiel.Close savechanges:=True
End Sub

Gruss Torsten
Anzeige
AW: 2 Dateien - Werte bedingt kopieren
25.02.2020 15:22:58
Enno
Hallo Torsten
Vielen Dank. Ich habe dein Vorschlag mal so eingebaut und getestet.
Leider stoppt der Code bei der folgenden Codezeile und markiert dabei in der Codezeile den Variablenname wsZiel:
LetzteZeile = wsZiel.Cells(Rows.Count, 1).End(xlUp).Row
Die Fehlermeldung dazu lautet: Fehler beim Kompilieren - ungültiger Bezeichner
Kannst du mir hier auch weiterhelfen?
Danke und Gruss
Enno
AW: 2 Dateien - Werte bedingt kopieren
26.02.2020 08:25:45
Torsten
Hallo Enno,
sorry. Mein Fehler. Hatte die Sheets als String definiert. Kann so nicht funktionieren.
Aber so sollte es gehen:

Option Explicit
Sub oeffnen_kopieren()
Dim wbQuelle As Workbook, wbZiel As Workbook
Set wbQuelle = ThisWorkbook
Dim strPfadZiel As String
strPfadZiel = "C:\MeinPfad\Zieldatei.xlsx"      'Pfad und Dateiname anpassen
Dim wsQuelle As String, wsZiel As String
wsQuelle = "Quellsheet"                         'Sheetname anpassen
Workbooks.Open (strPfadZiel)
Set wbZiel = ActiveWorkbook
wsZiel = "Zielsheet"                            'Sheetname anpassen
Dim Suchwert As Variant
Dim Suchzeile As Long, LetzteZeile As Long
LetzteZeile = wbZiel.Sheets(wsZiel).Cells(Rows.Count, 1).End(xlUp).Row
Set Suchwert = wbZiel.Sheets(wsZiel).Range("A1:A" & LetzteZeile).Find(wbQuelle.Sheets(wsQuelle). _
Range("M2"), LookIn:=xlValues, lookat:=xlWhole)
If Not Suchwert Is Nothing Then
Suchzeile = Suchwert.Row
wbZiel.Sheets(wsZiel).Cells(Suchzeile, 2) = wbQuelle.Sheets(wsQuelle).Cells(7, 3)
wbZiel.Sheets(wsZiel).Cells(Suchzeile, 4) = wbQuelle.Sheets(wsQuelle).Cells(8, 3)
wbZiel.Sheets(wsZiel).Cells(Suchzeile, 5) = wbQuelle.Sheets(wsQuelle).Cells(23, 14)
Else
LetzteZeile = wbZiel.Sheets(wsZiel).Cells(Rows.Count, 1).End(xlUp).Row
wbZiel.Sheets(wsZiel).Cells(LetzteZeile + 1, 2) = wbQuelle.Sheets(wsQuelle).Cells(7, 3)
wbZiel.Sheets(wsZiel).Cells(LetzteZeile + 1, 4) = wbQuelle.Sheets(wsQuelle).Cells(8, 3)
wbZiel.Sheets(wsZiel).Cells(LetzteZeile + 1, 5) = wbQuelle.Sheets(wsQuelle).Cells(23, 14)
End If
wbZiel.Close savechanges:=True
End Sub

Gruss Torsten
Anzeige
AW: 2 Dateien - Werte bedingt kopieren
26.02.2020 09:50:02
Enno
Hallo Torsten
Vielen Dank, jetzt läuft es einwandfrei.
Gruss Enno
gerne...
26.02.2020 10:03:04
Torsten
viel Spass

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige