Ich habe einen VBA Code der mir Spalten abgleicht und dann aus z.B. Spalte „A“ die Werte in eine neue Datei kopiert. Mein Problem dabei ist: Es wird die komplette Zeile und nicht nur der Wert in Spalte „A“ kopiert, was aber nicht sein soll. Kann mir da jemand weiter helfe? Der Code sieht wie folgt aus:
Private Sub CommandButton1_Click()
''Sub kopieren()
‚‘
''Workbooks(„Vergleich1.xlsm“).Worksheets(„Tabelle1“).Range(„A2:A12“).Copy _
''Workbooks(„Vergleich2.xlsx“).Worksheets(„Tabelle1“).Range(„A2“)
''End Sub
‚‘ Sub CopyDataWithCondition22()
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim lastRowSource As Long
Dim lastRowTarget As Long
Dim i As Long
Dim j As Long
Dim matchFound As Boolean
' Pfade zu den Dateien (Anpassen der Pfade notwendig)
Dim sourceFilePath As String
Dim targetFilePath As String
sourceFilePath = "C:\Users\Besitzer\Desktop\Vergleich1.xlsm"
targetFilePath = "C:\Users\Besitzer\Desktop\Vergleich2.xlsx"
On Error GoTo ErrHandler
' Öffne die Quelldatei
Set wbSource = Workbooks.Open(sourceFilePath)
If wbSource Is Nothing Then
MsgBox "Fehler beim Öffnen der Quelldatei.", vbCritical
Exit Sub
End If
Set wsSource = wbSource.Sheets("Tabelle1") ' Anpassen des Blattnamens falls notwendig
If wsSource Is Nothing Then
MsgBox "Fehler beim Öffnen des Arbeitsblatts in der Quelldatei.", vbCritical
Exit Sub
End If
' Öffne die Zieldatei
Set wbTarget = Workbooks.Open(targetFilePath)
If wbTarget Is Nothing Then
MsgBox "Fehler beim Öffnen der Zieldatei.", vbCritical
Exit Sub
End If
Set wsTarget = wbTarget.Sheets("Tabelle1") ' Anpassen des Blattnamens falls notwendig
If wsTarget Is Nothing Then
MsgBox "Fehler beim Öffnen des Arbeitsblatts in der Zieldatei.", vbCritical
Exit Sub
End If
' Letzte belegte Zeile in der Quelldatei in Spalte A
lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
Debug.Print "Letzte Zeile in der Quelldatei: " & lastRowSource
' Letzte belegte Zeile in der Zieldatei in Spalte A
lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
Debug.Print "Nächste freie Zeile in der Zieldatei: " & lastRowTarget
' Durchlaufen der Zeilen in der Quelldatei
For i = 2 To lastRowSource ' Starten bei Zeile 2, falls Zeile 1 Überschriften enthält
matchFound = False
' Durchlaufen der Zeilen in der Zieldatei, um Übereinstimmung in Spalte C und F zu finden.
' Spalten müssen eindeutige Unterscheidungsmerkmale haben, doppelte Werte werden ansonsten als ein Wert erkannt.
For j = 2 To lastRowTarget - 1 ' Starten bei Zeile 2, falls Zeile 1 Überschriften enthält
If wsSource.Cells(i, 3).Value = wsTarget.Cells(j, 3).Value And wsSource.Cells(i, 6).Value = wsTarget.Cells(j, 6).Value Then
matchFound = True
Exit For
End If
Next j
' Wenn Übereinstimmung gefunden wurde, kopiere die Daten aus Spalte A
If matchFound = False Then
wsTarget.Cells(lastRowTarget, 1).Value = wsSource.Cells(i, 1).Value
Debug.Print "Kopiert Wert: " & wsSource.Cells(i, 1).Value & " nach Zeile: " & lastRowTarget & " in Zieldatei"
lastRowTarget = lastRowTarget + 1
End If
Next i
' Bestätigungsmeldung anzeigen
MsgBox "Daten erfolgreich kopiert.", vbInformation
' Schließen der Arbeitsmappen
ErrHandler:
MsgBox "Fehler: " & Err.Description, vbCritical
On Error Resume Next
If Not wbSource Is Nothing Then wbSource.Close SaveChanges:=False
If Not wbTarget Is Nothing Then wbTarget.Close SaveChanges:=False
End Sub
Ich kenne mich nicht direkt mit VBA aus und verstehe deshalb nicht alles auf Anhieb, die doppelten Anführungszeichen am Zeilenanfang kommen mir aber komisch vor. Kann es sein dass das durch das Kopieren falsch formatierte einfache Anführungszeichen sind die die Zeilen auskommentieren?
Wobei ich gerade aber nichts anderes in dem Code finde dass sich auf ganze Zeilen bezieht bzw. scheint es keine dynamischen Spalten zu geben. Nur vom durchlesen würde ich denken dass nur aus und in Spalte A kopiert wird.
Hallo, danke das ihr geschaut habt. Ich stelle den Code nochmal vor. Ich habe einmal geringe Veränderungen in den Spalten C und D (Vor. und Nachname) in der Zieldatei vorgenommen, womit ja dann keine Paarigkeit mehr gegeben ist. Aber trotzdem kopiert er aus der Quelldatei die Werte in die Spalte A der Zieldatei.
Option Explicit
Private Sub CommandButton1_Click()
Dim wbSource As Workbook
Dim wbTarget As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim lastRowSource As Long
Dim lastRowTarget As Long
Dim i As Long
Dim j As Long
Dim matchFound As Boolean
' Pfade zu den Dateien (Anpassen der Pfade notwendig)
Dim sourceFilePath As String
Dim targetFilePath As String
sourceFilePath = "C:\Users\Besitzer\Desktop\Vergleich1.xlsm"
targetFilePath = "C:\Users\Besitzer\Desktop\Vergleich2.xlsx"
On Error GoTo ErrHandler
' Öffne die Quelldatei
Set wbSource = Workbooks.Open(sourceFilePath)
If wbSource Is Nothing Then
MsgBox "Fehler beim Öffnen der Quelldatei.", vbCritical
Exit Sub
End If
Set wsSource = wbSource.Sheets("Tabelle1") ' Anpassen des Blattnamens falls notwendig
If wsSource Is Nothing Then
MsgBox "Fehler beim Öffnen des Arbeitsblatts in der Quelldatei.", vbCritical
Exit Sub
End If
' Öffne die Zieldatei
Set wbTarget = Workbooks.Open(targetFilePath)
If wbTarget Is Nothing Then
MsgBox "Fehler beim Öffnen der Zieldatei.", vbCritical
Exit Sub
End If
Set wsTarget = wbTarget.Sheets("Tabelle1") ' Anpassen des Blattnamens falls notwendig
If wsTarget Is Nothing Then
MsgBox "Fehler beim Öffnen des Arbeitsblatts in der Zieldatei.", vbCritical
Exit Sub
End If
' Letzte belegte Zeile in der Quelldatei in Spalte A
lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
Debug.Print "Letzte Zeile in der Quelldatei: " & lastRowSource
' Letzte belegte Zeile in der Zieldatei in Spalte A
lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
Debug.Print "Nächste freie Zeile in der Zieldatei: " & lastRowTarget
' Durchlaufen der Zeilen in der Quelldatei
For i = 2 To lastRowSource ' Starten bei Zeile 2, falls Zeile 1 Überschriften enthält
matchFound = False
' Durchlaufen der Zeilen in der Zieldatei, um Übereinstimmung in Spalte C und D zu finden
For j = 2 To wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row ' Starten bei Zeile 2, falls Zeile 1 Überschriften enthält
If wsSource.Cells(i, 3).Value = wsTarget.Cells(j, 3).Value And wsSource.Cells(i, 4).Value = wsTarget.Cells(j, 4).Value Then
matchFound = True
Exit For
End If
Next j
' Wenn eine Übereinstimmung gefunden wurde, kopiere die Daten aus Spalte A
wsTarget.Cells(lastRowTarget, 1).Value = wsSource.Cells(i, 1).Value
Debug.Print "Kopiert Wert: " & wsSource.Cells(i, 1).Value & " nach Zeile: " & lastRowTarget & " in Zieldatei"
lastRowTarget = lastRowTarget + 1
Next i
If matchFound = False Then
' Bestätigungsmeldung anzeigen
MsgBox "Daten erfolgreich kopiert.", vbInformation
Exit Sub
ErrHandler:
MsgBox "Fehler: " & Err.Description, vbCritical
On Error Resume Next
If Not wbSource Is Nothing Then wbSource.Close SaveChanges:=False
If Not wbTarget Is Nothing Then wbTarget.Close SaveChanges:=False
du hast die if abfrage auch rausgenommen.
Am Ende der For-Schleife für die Target-Datei kopiert er. Egal ob was gefunden wurde oder nicht.
Danach kommt die nächste i-Schleife dran, bei der er wieder, wenn er j durch hat, kopieren wird.
if false then erfolgreich?
irgendwas sieht da ganz komisch aus.
[/code] am Ende des Codes und [code] am Anfang des Codes sollte ihn beim posten entsprechend formatieren und das ganze Formatierungschaos verhindern.
Zwischen der Quell- und Zieldatei hast du jeweils die Spalten C und F verglichen, nun sind es die Spalten C und D. Das sind immernoch Paare und ich sehe da jetzt keinen wirklichen Unterschied.