Hallo zusammen,

ich bastle gerade an einem Code:

Ich habe zwei Tabellen.

Ich möchte, dass die Inhalte der Quelldatei in die Zieldatei eingetragen werden, wenn der Text in Zeile 4 bzw. 10 und Spalte A beider Tabellen übereinstimmt.

Hier ein Beispiel:

Existiert ein Begriff in Spalte B in der Quelldatei nicht, dann soll es leer bleiben.

Den Code den ich bisher gefunden habe bezieht sich auf genaue Spaltenangaben.

Ich möchte, dass Excel in Zeile 4 (von A bis Q) der Quelldatei geht und mit Zeile 10 der Zieldatei vergleicht; wenn dann auch die Begriffe in Spalte A überein stimmen soll er die Zahl hineinschreiben.Die relevanten Zahlen in meiner Quelldatei sind von A1:Q37.

Sub Uebertragen_Frucht_1()
'Zieltabelle, Quelltabelle
Uebertragen_Frucht "Tabelle1", "Tabelle2"
End Sub


Function Uebertragen_Frucht(Ziel As String, Quelle As String)
  Dim colDummy As Collection
  Dim colZeilen As New Collection
  Dim i As Long
  Dim k As Long
  Dim colQuelle As Long
  Dim colZiel As Long
  Dim strSearch As String
  Dim varDummy As Variant
  Dim wsZiel As Worksheet
  Dim wsQuelle As Worksheet
  Dim dtmBeginn As Date
  
  On Error Resume Next
  
  dtmBeginn = Now
  
  Set wsZiel = Worksheets(Ziel)
  Set wsQuelle = Worksheets(Quelle)
  
  With wsQuelle 'Quelldatei
    For i = 5 To 50
      strSearch = CStr(.Cells(i, 1))
      If strSearch <> "" Then
        Set colDummy = New Collection
        colZeilen.Add colDummy, "X-" & strSearch
        colZeilen("X-" & strSearch).Add i, "Quellzeile"
      End If
    Next
    'Zielspalte ermitteln
    
    strSearch = wsQuelle.Range("D4").Text 'gesuchte Frucht in Quelldatei
    Set varDummy = wsZiel.Rows(10).Find(what:=strSearch, LookIn:=xlValues, lookat:=xlWhole)
    If varDummy Is Nothing Then
      MsgBox "Frucht """ & strSearch & """ nicht in Zeile 4 der Zieltabelle gefunden!"
      GoTo Beenden
    Else
      colZiel = varDummy.Column
    End If
    
  End With
  
    With wsZiel
    For i = 5 To 50
      strSearch = CStr(.Cells(i, 1))
      If strSearch <> "" Then
        colZeilen("X-" & strSearch).Add i, "Zielzeile"
      End If
    Next
    
    'Quellspalte ermitteln
    strSearch = wsZiel.Range("D4").Text
    Set varDummy = wsQuelle.Rows(4).Find(what:=strSearch, LookIn:=xlValues, lookat:=xlWhole)
    If varDummy Is Nothing Then
      MsgBox "Frucht """ & strSearch & """ nicht in Zeile 4 der Quelltabelle gefunden!"
      GoTo Beenden
    Else
      colQuelle = varDummy.Column
    End If
    
  End With
  
  With wsZiel 'Zieldatenblatt
    Application.ScreenUpdating = False
    For Each varDummy In colZeilen
      i = varDummy("Zielzeile")
      k = varDummy("Quellzeile")
    
      .Cells(i, colZiel).Value = wsQuelle.Cells(k, colQuelle).Value
    Next
  End With
  
Beenden:
  Application.ScreenUpdating = True
  
  

End Function

Vielen Dank! Und Viele Grüße,

Pan