2 Tabellen zusammenführen

[AlterDresdner]

Hallo,
da ich glaube, die Beiträge im anderen Office-Forum helfen Dir so richtig nicht weiter, hier ein Versuch, ob ich Deine Bitte richtig verstanden habe.
Die Konstanten am Anfang musst Du bei Änderung der Datenstruktur (die in der Tat überarbeitungswürdig ist, vermutlich aber nicht von Dir zu vertreten ist), ggfls. anpassen.

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) Then 'ID auch in Ziel
        ZZeile = erg.Row + 1
        If Ziel.Cells(ZZeile, 1) <> STID Then 'ggfls. Zeile einfügen
          Ziel.Rows(ZZeile).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
          Ziel.Cells(ZZeile, 1) = STID
        End If
        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