Thema: Kopien in definierte Bereiche gem. Suchkriterium

Hallo,
ich benötige ein Marko, dass anhand eines Suchkriteriums in Zelle
DokB.In!H1 einen Wertebereich von DokB.In nach Calc transferiert (vgl.
Upload).
Ist Projekt 1 gewählt, sollen die Werte in Tabelle "Calc" in die Maske für
Projekt 1 kopiert werden. Falls Projekt 2 gewählt ist, dann entsprechend in
die Maske für Projekt 2. Alle Werte sollen so eingefügt werden, dass dabei
die übrigen Masken nicht (!) überschrieben werden.
Für die Tabelle "Calc" gibt es 2 Alternativen. Die Wunschvorstellung: Jeder
Textblock ist durch nur eine Zeile vom nächsten getrennt. Einfacher wird es
natürlich, wenn der Zeilenabstand aus DokB.In beibehalten wird, da muss nur
1 Block kopiert werden. Das wäre auch OK.
Danke Stefan
https://www.herber.de/bbs/user/100307.xlsm

Moin Stefan

Dim zelle As Range
Set zelle = Worksheets("Calc").Rows("2:2").Find(What:=Worksheets("DokB.In").Range("H1"), LookIn: _
=xlValues, lookat:=xlWhole) '--sucht die Projektzelle
If Not zelle Is Nothing Then  '--wenn vorhanden
zelle.Offset(1, 0).Value = Worksheets("DokB.In").Range("H39").Value
zelle.Offset(21, 0).Value = Worksheets("DokB.In").Range("H75").Value
'--usw.
'die erste Zahl in Offset gibt an wieviel Zeilen unterhalb von Zeile 2 eingetragen wird
End If

den Rest bekommst du hin.Einfach ausprobieren.
gruss hary

Hallo Harry,
vielen Dank für diese Lösung. Gelingt erstklassig.
Stefan

Hallo,
ich benötige ein Marko, dass anhand eines Suchkriteriums in Zelle
DokB.In!H1 einen Wertebereich von DokB.In nach Calc transferiert (vgl.
Upload).
Ist Projekt 1 gewählt, sollen die Werte in Tabelle "Calc" in die Maske für
Projekt 1 kopiert werden. Falls Projekt 2 gewählt ist, dann entsprechend in
die Maske für Projekt 2. Alle Werte sollen so eingefügt werden, dass dabei
die übrigen Masken nicht (!) überschrieben werden.
Für die Tabelle "Calc" gibt es 2 Alternativen. Die Wunschvorstellung: Jeder
Textblock ist durch nur eine Zeile vom nächsten getrennt. Einfacher wird es
natürlich, wenn der Zeilenabstand aus DokB.In beibehalten wird, da muss nur
1 Block kopiert werden. Das wäre auch OK.
Danke Stefan
https://www.herber.de/bbs/user/100307.xlsm

Moin Stefan

Dim zelle As Range
Set zelle = Worksheets("Calc").Rows("2:2").Find(What:=Worksheets("DokB.In").Range("H1"), LookIn: _
=xlValues, lookat:=xlWhole) '--sucht die Projektzelle
If Not zelle Is Nothing Then  '--wenn vorhanden
zelle.Offset(1, 0).Value = Worksheets("DokB.In").Range("H39").Value
zelle.Offset(21, 0).Value = Worksheets("DokB.In").Range("H75").Value
'--usw.
'die erste Zahl in Offset gibt an wieviel Zeilen unterhalb von Zeile 2 eingetragen wird
End If

den Rest bekommst du hin.Einfach ausprobieren.
gruss hary

Hallo Harry,
vielen Dank für diese Lösung. Gelingt erstklassig.
Stefan