Excel Makro zur Datenübertragung A -> B

Hallo Zusammen,

ich möchte ein Makro schreiben, das mir automatisch hilft, die Werte aus der Excel-Datei "A" in meine Excel-Datei "B" zu übertragen, sobald es aktiviert wird.

Beide Tabellen kann man unter dem Link https://www.herber.de/bbs/user/164070.xlsx (A) und https://www.herber.de/bbs/user/164070.xlsx (B) runterladen (Muster - Übungsdateien).

Wenn bestimmte Daten in beiden Tabellen übereinstimmen, sollen diese übertragen werden. Andernfalls soll das Feld in Tabelle B leer bleiben.

Die relevanten Daten befinden sich im Reiter "Tabelle1", unter der Überschrift B1:E1 und im Bereich A1:A7. Wenn die Daten übereinstimmen, sollen die Zahlen aus Excel A in Tabelle B übertragen werden. Da sich die Reihenfolge ändern kann, ist die Verwendung der Indexfunktion hier sehr hilfreich - vermutlich.

BG

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Vielen Dank :) mit der Formel habe ich bereits gearbeitet und versuche das irgendwie in VBA. Ich starte das Makro bei B über eine Schaltfunktion.
Leider habe ich einen kleinen Fehler und weiß gerade nicht weiter... :( Er übernimmt immer die Ergebnisse bei Namen die er in A nicht gefunden hat. Ich möchte da natürlich den Wert 0 stehen haben. Ggfs. komme ich ja morgen darauf.

ASM Zählen 2022 Zählen 2023
Peter 8564 66998
Meikel 245 5469
David 511 5489
Chris 511 799 --- Falsch
Thomas 9684 3214
Anni 9684 1235 --- Falsch

Hier ein Beispiel:

Option Explicit

Sub FortlaufendDatenÜbertragen()
Dim QuellDatei As Workbook
Dim ZielDatei As Workbook
Dim QuellBereich As Range
Dim ZielBereich As Range
Dim Suchwert As Variant
Dim SpaltenIndex As Variant
Dim ZeilenIndex As Variant
Dim ZeileA As Long

Set ZielDatei = ThisWorkbook ' Dies ist die aktuelle Excel-Datei (B.xlsx)

ZeileA = 2 ' Start in Zeile 2

' Öffnen der Quell-Datei
Set QuellDatei = Workbooks.Open("X:\A.xlsx")

' Festlegen des Spaltenindex
SpaltenIndex = Application.WorksheetFunction.Match(ZielDatei.Sheets("Tabelle1").Range("B1").Value, QuellDatei.Sheets("Tabelle1").Range("1:1"), 0)

Do While ZielDatei.Sheets("Tabelle1").Cells(ZeileA, 1).Value > ""
' Festlegen des Suchwerts
Suchwert = ZielDatei.Sheets("Tabelle1").Cells(ZeileA, 1).Value

' Überprüfen, ob der Suchwert in Excel A vorhanden ist
On Error Resume Next
ZeilenIndex = Application.WorksheetFunction.Match(Suchwert, QuellDatei.Sheets("Tabelle1").Range("A:A"), 0)
On Error GoTo 0

' Übertragen der Daten, wenn der Name gefunden wurde, andernfalls die Zelle leer lassen
If Not IsError(ZeilenIndex) Then
Set QuellBereich = QuellDatei.Sheets("Tabelle1").Cells(ZeilenIndex, SpaltenIndex)
Set ZielBereich = ZielDatei.Sheets("Tabelle1").Cells(ZeileA, 2) ' Hier können Sie den Zielbereich anpassen
ZielBereich.Value = QuellBereich.Value
End If

' Zur nächsten Zeile in Zeile A wechseln
ZeileA = ZeileA + 1
Loop

' Schließen der Quell-Datei
QuellDatei.Close SaveChanges:=False
End Sub

Beliebteste Forumthreads (12 Monate)

Excel Makro zur Datenübertragung A -> B

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread