Spalteninhalte kopieren wenn Bedingung erfüllt.

J

josef24

Erfahrenes Mitglied
Hallo zusammen. Ich suche nach einer Lösung für folgendes Problem. Habe bereits einiges versucht, aber leider ohne Erfolg. Hatte mir erhofft, dass die künstliche Intelligenz mir weiter helfen könnte, aber dem war nicht so. Sorry, nun muss ich doch noch die VBA Spezialisten unter ihnen bitten, mir nach Möglichkeit weiterzuhelfen.

Ich möchte Werte aus Spalte "A" der Datei Listemit.xls in Spalte "A" der Datei Listeohne.xlsm einfügen. Dabei soll abgeglichen werden, ob die Namen (TEXT) identisch sind. Bei Übereinstimmung soll die entsprechende Zelle mit dem nummerischen Wert reinkopiert werden. Der Code bringt keine Fehlermeldung, aber er kopiert auch keinen Wert wie gewünscht. Meinen Versuch stelle ich hier mal ein. Danke für jegliche Unterstützung. Gruß Josef
Visual Basic: 
Option Explicit

Sub Daten_uebertragen_Neu()
    Dim wbQuelle As Workbook, wbZiel As Workbook
    Dim wsQuelle As Worksheet, wsZiel As Worksheet
    Dim i As Long
    Dim wertBZiel As String
    Dim c As Range
    Dim letzteZeileQuelle As Long, letzteZeileZiel As Long

    ' Arbeitsmappen öffnen
    Set wbQuelle = Workbooks.Open("C:\Users\Besitzer\Desktop\Listemit.xls") ' Quelldatei
    Set wbZiel = Workbooks.Open("C:\Users\Besitzer\Desktop\Listeohne.xlsm") ' Zieldatei

    ' Arbeitsblätter festlegen
    Set wsQuelle = wbQuelle.Sheets(1) ' Tabelle in Listemit
    Set wsZiel = wbZiel.Sheets(1)     ' Tabelle in Listeohne

    ' Letzte Zeilen in beiden Arbeitsblättern ermitteln
    letzteZeileQuelle = wsQuelle.Cells(wsQuelle.Rows.Count, 2).End(xlUp).Row ' Letzte Zeile in Spalte B von Listemit
    letzteZeileZiel = wsZiel.Cells(wsZiel.Rows.Count, 2).End(xlUp).Row       ' Letzte Zeile in Spalte B von Listeohne

    ' Durch die Zeilen von Spalte B in der Zieldatei (Listeohne) iterieren
    For i = 1 To letzteZeileZiel
        wertBZiel = Trim(wsZiel.Cells(i, 2).Value) ' Wert in Spalte B der aktuellen Zeile von Listeohne

        ' Nur nach nicht leeren Werten in Spalte B suchen
        If wertBZiel <> "" Then
            ' Spalte B in der Quelldatei durchsuchen
            With wsQuelle.Columns("B")
                Set c = .Find(wertBZiel, LookIn:=xlValues, LookAt:=xlWhole) ' Suche nach dem Wert in Spalte B der Quelldatei

                ' Wenn der Wert in der Quelldatei gefunden wird
                If Not c Is Nothing Then
                    ' Kopiere den Wert aus Spalte A der Quelldatei (Listemit) nach Spalte A der Zieldatei (Listeohne)
                    wsZiel.Cells(i, 1).Value = wsQuelle.Cells(c.Row, 1).Value
                End If
            End With
        End If
    Next i

    ' Hinweis, dass der Vorgang abgeschlossen ist
    MsgBox "Datenübertragung abgeschlossen!", vbInformation
End Sub
 
Klingt nachdem gleichen Problem wie im Thread von dir
J

Thema 'Ausgewählte Werte aus Spalte in neue Datei kopieren'

Hallo, komme mal wieder mit einer Frage. Ich möchte Werte aus einer Datei/Tabelle in eine neue Tabelle kopieren. Ich wähle in den Spalte C und D die zugehörigkeiten zu den einzelnen Datensätzen in der neuen Datei aus. Mein Problem ist dabei, das der Inhalt erfasst, aber nicht in die neue Datei kopiert wird sonder in der Quelldatei im Anschluss an bereits bestehende Werte angefügt wird. Meine Vermutung ist, dass der Fehler im folgenden Codeabschnitt ist.
Visual Basic: 
        ' Wenn eine Übereinstimmung gefunden wurde, kopiere die Daten aus Spalte A
        If matchFound Then...

Leider hast du die Lösung nicht reingeschrieben.

laut debugger springt er in die entsprechenden Zeilen rein, wird nur nicht gespeichert?
Pro pro speichern, muss man ev. noch Save oder so zum speichern der Datei aufrufen?
 
Anstatt der Find-Methode, innere Schleife und durch die Quelldatei laufen, und die Werte direkt vergleichen.

In Zeile 25 "Trim"-t er den Wert in der Zieldatei, danach "Trim"-t er nichts für die Quelldatei.

In reinem Excel ist das eigentlich ein SVERWEIS, mit dem Problem, dass er Werte aus einer Spalte Links vom Kriterium zurückgeben will.
Es gibt aber eine Alternative zu SVERWEIS, die das kann:
SVERWEIS versus INDEX / VERGLEICH – Excel-Inside Solutions
 
Sorry, erinnerte mich grad nichts mehr an meinen Beitrag. Also, es war nicht die Lösung. Erst nachher habe ich gesehen, dass die komplette Spalte und nicht die gewünschte Auswahl an Zellinhalten ausgewählt und in die neue Datei eingefügt wurde. Soweit ich weiß, ist für den Vergleich in 2 Dateien ein VBA Code von Vorteil.
 
josef24 hat gesagt.:
Soweit ich weiß, ist für den Vergleich in 2 Dateien ein VBA Code von Vorteil.
Zum Vergrößern anklicken....
Unfug.
Wie schon erwähnt, kann Excel das auch ohne VBA.

Für beide Varianten (Excel-Funktion bzw. VBA) gilt jedoch:
Es funktioniert nur, wenn du Äpfel mit Äpfeln vergleichst.
Auch ein VBA-Code wird für
Code: 
If "Zvoni" = "  Zvoni  " Then
nie Wahr zurückgeben.

Ein
Code: 
If Trim("Zvoni") = Trim("  Zvoni  ") Then
jedoch schon....
 
Hallo, habe den Code mit meinen mitteln einmal verändert. Jetzt wird ein Fehler bei:
Visual Basic: 
' Arbeitsblätter festlegen
    Set wsQuelle = wbQuelle.Sheets(1) ' Tabelle in Listemit
    Set wsZiel = wbZiel.Sheets(1)     ' Tabelle in Listeohne
angezeigt.
anwendungs und objectdefinierter Fehler
Laufzeitfehler 1004

Der Pfad und die Tabellenbezeichnungen sind korrekt, x mal kontrolliert.

Der Code sieht wie folgt aus:

Visual Basic: 
Sub DatenKopieren()
    Dim wbMit As Workbook
    Dim wbOhne As Workbook
    Dim wsMit As Worksheet
    Dim wsOhne As Worksheet
    Dim letzteZeileMit As Long
    Dim letzteZeileOhne As Long
    Dim i As Long, j As Long
    
    ' Öffnen der Dateien
    Set wbMit = Workbooks.Open("C:\Users\Besitzer\Desktop\Listemit.xls")
    Set wbOhne = Workbooks.Open("C:\Users\Besitzer\Desktop\Listeohne.xls")
    
    ' Festlegen der Arbeitsblätter
'    On Error Resume Next
    Set wsMit = wbMit.Sheets("Tabelle2")
    If wsMit Is Nothing Then
        MsgBox "Arbeitsblatt 'Tabelle2' nicht gefunden in der Datei 'Listemit.xls'", vbExclamation
        Exit Sub
    End If
    
    Set wsOhne = wbOhne.Sheets("Tabelle1")
    If wsOhne Is Nothing Then
        MsgBox "Arbeitsblatt 'Tabelle1' nicht gefunden in der Datei 'Listeohne.xls'", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    ' Bestimmen der letzten Zeile in beiden Tabellen
    letzteZeileMit = wsMit.Cells(wsMit.Rows.Count, 1).End(xlUp).Row
    letzteZeileOhne = wsOhne.Cells(wsOhne.Rows.Count, 2).End(xlUp).Row

    ' Daten vergleichen und kopieren
    For i = 1 To letzteZeileMit
        For j = 1 To letzteZeileOhne
            If wsMit.Cells(i, 2).Value = wsOhne.Cells(j, 2).Value Then
                wsMit.Cells(i, 1).Copy Destination:=wsOhne.Cells(j, 1)
            End If
        Next j
    Next i
    
    ' Speichern und Schließen der Dateien
    wbOhne.Save
''    wbOhne.Close False
''    wbMit.Close False
End Sub

Vielleicht ist noch jemand bereit mir eine Lösung zu liefern. Bedanke mich jetzt schon und Gruß Josef
 
Was ist jetzt genau das Problem?
Im letzten Post hast du 2 Quellcode ausschnitte, der erste schmeißt einen Fehler, im 2ten Quellcode zeigst du uns wohl deinen kompletten Code, wo der obere Teil mit dem Fehler garnicht vorkommt.

Mittlerweile, sehe ich, ist jetzt auch ein Save drin.
Springt er im debugger zumindest in die Stelle rein wo der Zellenwert verändert werden soll?

Ev. müssen die Arbeitsblätter noch mittels Activate Methode aktiviert werden.
 
Zuletzt bearbeitet:
Spyke hat gesagt.:
Ev. müssen die Arbeitsblätter noch mittels Activate Methode aktiviert werden.
Zum Vergrößern anklicken....
Müssen sie nicht. Ich hab genug Excel-VBA in den Knochen um das zu wissen

EDIT:
Zeile 30/31:
LetzteZeileMit wird aus Spalte A von wsMit ermittelt
LetzteZeileOhne aus Spalte B von wsOhne

Im allerersten Post holt er beide aus Spalte B jeweils

*seufz*

Übrigens: Das Cells-Objekt kann auch den Spaltenbuchstaben im zweiten Argument nutzen.
Code: 
letzteZeileMit = wsMit.Cells(wsMit.Rows.Count, "B").End(xlUp).Row
 
Zuletzt bearbeitet:
Wenn sich zwei streiten, freut sich in dem Falle der dritte nicht. Er hatte insgeheim auf eine etwas weiter gehende Unterstützung gehofft. Gruß
 
josef24 hat gesagt.:
Wenn sich zwei streiten, freut sich in dem Falle der dritte nicht. Er hatte insgeheim auf eine etwas weiter gehende Unterstützung gehofft. Gruß
Zum Vergrößern anklicken....
Und welche Unterstützung?
Dein letzter Code hat auf einmal ganze andere Variablen-Namen als in deinem Original-Post.
Dann gibt es Unterschiede zwischen dem letzten Code und dem ersten (Siehe mein Post darüber).

Und es gibt noch immer keine Angabe, in welcher Zeile dein Code fehlschlägt.
Eine Aussage "Funktioniert nicht" ist unnütz.

Ich rufe auch nicht in meiner Auto-Werkstatt an: "Mein Auto geht nicht"
Bekomme ich nämlich auch zur Antowrt: "Yo. Danke für den Anruf" *click* aufgelegt
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück