Clever-Excel-Forum

Hallo,

wer kann mir bei folgender Aufgabe weiterhelfen. Ich habe eine Tabelle, in der in Spalte S ungefähr jede 10 Zeile ein Eintrag steht. Jetzt möchte ich gerne per VBA Code diese Einträge von unten nach oben in die jeweils darüber liegenden leeren Zeilen kopieren. Ich habe bereits einen Code gefunden, welcher diese Aufgabe von oben nach unten erfüllt (siehe unten). Eventuell kann mir da von Euch jemand weiterhelfen bzw. den unten angegebenen Code diesbezüglich anpassen.

Vielen Dank

Code:
Sub Ausfuellen_nach_unten()

    With Intersect(Columns("S"), ActiveSheet.UsedRange)

    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"

    .Value = .Value

    End With

End Sub

Hallöchen,

hast Du schon mal mit den Zahlen in dem Formelteil experimentiert?

"=R[-1]C"

Hallo Schauan,

habe da schon was ausprobiert, er wurde dann jedoch nur jede befüllte Zelle jeweils einmal nach oben kopiert und nicht der gesamte darüber liegende Bereich ausgefüllt.

Hallöchen,

also, wenn Du statt -1 nur 1 schreibst, macht der Code das Gleiche, nur nach oben. Wenn Deiner Aufgabe zufolge alles tiefer setzen passt

Zitat: Ich habe bereits einen Code gefunden, welcher diese Aufgabe von oben nach unten erfüllt (siehe unten).

(ausgenommen die letzte Zeile, sollte doch auch alles höher setzen (ausgenommen die erste Zeile) passen.

Hallo Schauan,

wenn ich statt -1 nur 1 einsetze macht der Code das was ich vorher erwähnte: es wird nur eine Zelle darüber mit dem Wert befüllt und der Rest mit 0.

Hallöchen,

nein, es werden wie bei -1 alle Zeilen dazwischen gefüllt. Spalte A ist hier mit -1 gefüllt, Spalte B mit 1 und Spalte C zeigt, wie es vorher aussah.

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C
4	"=R[-1]C"	"=R[1]C"	vorher
5	1	1	1
6	1	2
7	1	2
8	1	2
9	1	2
10	2	2	2
11	2	3
12	2	3
13	2	3
14	2	3
15	2	3
16	2	3
17	3	3	3

Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016

Hallo,

hier eine Variante ohne Formelnzwischenschritt:

Sub Ausfuellen_nach_unten()

  Dim rngBlock As Range

  If Application.CountBlank(Application.Intersect(ActiveSheet.UsedRange, Columns("S"))) Then

  For Each rngBlock In Columns("S").SpecialCells(xlCellTypeBlanks).Areas

    rngBlock.Value = rngBlock.Cells(1).End(xlDown).Value

  Next rngBlock

  End If

End Sub

Gruß Uwe

sunny01

schauan

sunny01

schauan

sunny01

schauan

Kuwer