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
(24.02.2022, 13:30)Strolchi1980 schrieb: [ -> ]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?
Ja genau für Jede ID soll die entsprechende Zeile mit dem entsprechenden Wert eingetragen werden.
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
Ich fasse es nicht genau das habe ich gebraucht wirklich Tausend Dank an dich!
Hallo, danke für Rückmeldung!