In Excel mit VBA Zellen aus anderem Arbeitsblatt kopieren?

Hallo,

ich habe zwei Excel:

In Datei A stehen in Spalte A verschiedene Codes, und dann in den Spalten D bis G Daten.

In Datei B brauche ich jetzt ein Makro, das zu einem Code, der in einer Zelle steht (also sagen wir in C1 steht "XY2345", aus Datei A alle Werte der Spalten D bis G in Datei B kopieren und zwar in ein anderes Tabellenblatt (sagen wir "ZZZ).

Kennt sich da von euch jemand aus? Das sollte eine einfache Schleife sein, aber ich weiß nicht wie das funktioniert... es sollen der Reihe nach (bis zum letzten Wert in Datei B) jede Zeile ausgelesen werden, und wenn der Code stimmt, dann die Werte aus D bis G eben in die andere Datei kopiert werden. Sollte ja eigentlich nicht so schwer sein, oder? Kann mir da jemand helfen?

Vielen vielen Dank!

Answer 1

[Suboptimierer]

Ich halte ChatGPT nicht für ein Allheilmittel, aber das ist wunderbar dafür geeignet, um sich einen Ansatz von der KI generieren zu lassen. Falls es nicht die Endlösung, ist, inspiriert dich vielleicht der Ansatz für eigene Ideen.

Sub KopiereDaten()
    Dim wbA As Workbook ' Datei A
    Dim wbB As Workbook ' Datei B
    Dim wsA As Worksheet ' Arbeitsblatt in Datei A
    Dim wsB As Worksheet ' Arbeitsblatt ZZZ in Datei B
    Dim SuchCode As String ' Der Suchcode aus C1
    Dim letzteZeileA As Long ' Letzte Zeile in Datei A
    Dim letzteZeileB As Long ' Nächste freie Zeile in Blatt ZZZ
    Dim zeileA As Long ' Laufvariable für Zeilen in Datei A
    Dim pfadDateiB As String ' Pfad zur Datei B


    ' Datei A und Blatt festlegen
    Set wbA = Workbooks("DateiA.xlsx") ' Name der Datei A anpassen
    Set wsA = wbA.Sheets(1) ' Arbeitsblatt in Datei A anpassen


    ' Pfad zu Datei B angeben
    pfadDateiB = "C:\Pfad\Zur\DateiB.xlsx" ' Den tatsächlichen Dateipfad hier einfügen


    ' Prüfen, ob Datei B geöffnet ist, und öffnen, falls nicht
    On Error Resume Next
    Set wbB = Workbooks("DateiB.xlsx") ' Name der Datei B anpassen
    On Error GoTo 0
    If wbB Is Nothing Then
        Set wbB = Workbooks.Open(pfadDateiB)
    End If


    ' Blatt ZZZ in Datei B festlegen
    Set wsB = wbB.Sheets("ZZZ") ' Zielblatt in Datei B


    ' Suchcode aus Datei B lesen
    SuchCode = wbB.Sheets(1).Range("C1").Value ' Arbeitsblatt ggf. anpassen


    ' Letzte Zeile in Datei A bestimmen
    letzteZeileA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row


    ' Letzte freie Zeile in Blatt ZZZ bestimmen
    letzteZeileB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row + 1


    ' Schleife durch die Zeilen von Datei A
    For zeileA = 1 To letzteZeileA
        If wsA.Cells(zeileA, "A").Value = SuchCode Then
            ' Werte aus Spalten D bis G kopieren
            wsB.Cells(letzteZeileB, 1).Resize(1, 4).Value = wsA.Cells(zeileA, 4).Resize(1, 4).Value
            ' Zielzeile erhöhen
            letzteZeileB = letzteZeileB + 1
        End If
    Next zeileA


    ' Rückmeldung an den Nutzer
    MsgBox "Daten wurden erfolgreich kopiert.", vbInformation
End Sub

Quelle: ChatGPT

Comments

[PPauli]

Hallo, danke für den guten Input! Daran hätte ich gar nicht gedacht. Auf jeden Fall eine große Hilfe!