Wert in Zeilen kopieren VBA?

Hallo zusammen,
ich habe eine Aufgabe, bei der ich nicht mal ansatzweise weiß wie ich anzufange habe. Das Bild illustriert das Ganze. Es sollen die Werte der ersten Ziel in die Folgezeilen übernommen werden, die darin enthalten Daten können überschrieben werden.
Die Schwierigkeiten sind:

Die Anzahl der untergeordneten Zeilen ist variabel

Die Angaben in den ersten drei Spalten können mehrfach auftreten. Im Beispiel steht in Spalte E 95% das beudetet, das es weiter unten in der Liste noch einmal dieselben Daten gibt, allerding mit 5%. Der Unterschied ist dabei der Wert in Spalte D (im Bsp. 100120)

Am Ende soll das Produkt aus Spalte E und H gebildet werden. Die Überschriftzeilen danach auch gelöscht werden.
War das halbwegs verständlich und könnt Ihr mir helfen?
Danke,
Thomas
Userbild

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

ohne Gewähr und mach vorher sicherung ^^
Das Makro schaut in die Spalte A und wenn es dort einen neuen Wert entdeckt nimmt es das als vergleich , dann nimmt es den Wert in Spalte D und E als "Master"
Nun schaut es in die nächste Zeile und wenn dort das gleiche drinsteht wie in er Zelle die als Vergleich zählt, schreibt sie in Spalte D und E den Wert vom "Master"
Das geht solange, bis alle Zeilen gerpüft sind. Am Schluß wird noch die Produktformel ergänzt.


Sub kopieren()
Dim prüf As String
prüf = Cells(1, 1)
zeile = 1
anzahl = Cells(65000, 1).End(xlUp).Row
For i = 1 To anzahl Step 1
If Cells(i, 1) = prüf Then Range(Cells(i, 4), Cells(i, 5)).Value = Range(Cells(zeile, 4), Cells(zeile, 5)).Value
If Cells(i, 1) <> prüf Then prüf = Cells(i, 1): zeile = i
Next i
Range(Cells(1, 9), Cells(anzahl, 9)).FormulaR1C1 = "=RC[-1]*RC[-4]"
End Sub

Sub kopieren() Dim prüf As String prüf = Cells(1, 1) zeile = 1 For i = 1 To Cells(65000, 1).End(xlUp).Row Step 1 If Cells(i, 1) = prüf Then Range(Cells(i, 4), Cells(i, 5)).Value = Range(Cells(zeile, 4), Cells(zeile, 5)).Value Cells(i, 9).FormulaR1C1 = "=RC[-1]*RC[-4]" If Cells(i, 1) <> prüf Then prüf = Cells(i, 1): Rows(zeile).ClearContents: zeile = i Next i Rows(zeile).ClearContents End Sub

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wert in Zeilen kopieren VBA?

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread