2 Tabellen zusammenführen

[Strolchi1980]

Ich habs jetzt auch hin bekommen ihn in die Original Datei zu bekommen und bin überwältigt, wenn man es jetzt noch hin bekommt das alles ID übertragen und die Werte dazu eingetragen werden ist es exakt das was ich brauchte.... Tausend Tausend Dank

[AlterDresdner]

Ich habs jetzt auch hin bekommen ihn in die Original Datei zu bekommen und bin überwältigt, wenn man es jetzt noch hin bekommt das alles ID übertragen und die Werte dazu eingetragen werden ist es exakt das was ich brauchte.... Tausend Tausend Dank

Da müsstest Du mal genauer schreiben, was Du willst. Momentan passiert bei mehrfacher ID in der Quelle Folgendes:
Beim 1. Mal Zeile einfügen, Werte einsetzen. Beim 2. und den nächsten Malen werden nur die Werte eingesetzt.
Soll jeweils bei jedem Auftreten eine Zeile eingefügt werden?

[Strolchi1980]

Ja genau für Jede ID soll die entsprechende Zeile mit dem entsprechenden Wert eingetragen werden.

[AlterDresdner]

Hallo,
dann würde es so aussehen:

Code:

Sub Ergaenzung()
Const QuellIDSpalte = 32 'Spalte STID in Quelle
Const FirstDat = 123 'erste  Spalte mit Datum in Quelle
Dim Quelle As Object, Ziel As Object, erg As Variant
Dim QZeile As Long, QSpalte As Long, STID As String, ZZeile As Long, MyDiff As Long
  Set Quelle = ThisWorkbook.Sheets("Master_VNB")
  Set Ziel = ThisWorkbook.Sheets("Gesamt_mit_Forecast")
  With Quelle
    MyDiff = DateDiff("m", Ziel.Cells(1, 3), .Cells(1, FirstDat))
    For QZeile = 2 To .Cells(Rows.Count, QuellIDSpalte).End(xlUp).Row
      STID = .Cells(QZeile, QuellIDSpalte)
      Set erg = Ziel.Range("A:A").Find(what:=STID, lookat:=xlWhole)
      If Not (erg Is Nothing) And STID <> "" Then 'ID auch in Ziel und nicht leer
        ZZeile = erg.Row + 1
        Ziel.Rows(ZZeile).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'Zeile einfügen
        Ziel.Cells(ZZeile, 1) = STID
        QSpalte = FirstDat
        Do
          If Val(.Cells(QZeile, QSpalte)) > 0 Then 'wert vorhanden
            Ziel.Cells(ZZeile, QSpalte - FirstDat + 3 + MyDiff) = Quelle.Cells(QZeile, QSpalte)
          End If
          QSpalte = QSpalte + 1
        Loop Until IsEmpty(.Cells(1, QSpalte))
      End If
    Next QZeile
  End With
End Sub

[Strolchi1980]

Ich fasse es nicht genau das habe ich gebraucht wirklich Tausend Dank an dich!

[AlterDresdner]

Hallo, danke für Rückmeldung!