Anzeige
Archiv - Navigation
1556to1560
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zelle in nächste Zeile kopieren

Zelle in nächste Zeile kopieren
17.05.2017 15:57:21
Lesepeter
Hallo,
ich möchte gerne den Zelleninhalt solange in die nächste Zeile kopieren bis diese einen Inhalt hat.
Beispiel:
In A2 steht "123". In A20 steht "ABC". Ich möchte also den Inhalt in A2 bis zu A19 kopieren und dann den Inhalt von A20 solange runter kopieren bis wieder ein Zelleninhalt kommt, usw.
Abbrechen soll das Ganze entweder z.B. ab Zeile 500 oder wenn nach 50 Zeilen kein neuer Inhalt kommt. Leichter wäre wahrscheinlich ab einer bestimmten Zeile abzubrechen, damit keine Endlosschleife entsteht.
Würde so etwas in VBA gehen?
Bitte um Hilfe...

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zelle in nächste Zeile kopieren
17.05.2017 16:13:53
Michael
Hallo!
Hier wäre einmal eine Möglichkeit:
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim r As Range, rCount&, v
Set r = Ws.Range("A2")
Do Until rCount > 50
v = r.Value
Set r = r.Offset(1, 0)
If IsEmpty(r) Then
rCount = rCount + 1
r.Value = v
Else: rCount = 1
End If
Loop
End Sub
für den Fall wenn nach 50 Zeilen kein neuer Inhalt kommt
LG
Michael
AW: Zelle in nächste Zeile kopieren
17.05.2017 16:19:18
Michael
... und so
Sub b()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim i&, v
With Ws
For i = 2 To 500
If IsEmpty(.Cells(i, 1)) Then
.Cells(i, 1).Value = v
Else: v = .Cells(i, 1).Value
End If
Next i
End With
End Sub
für den Fall Abbrechen soll das Ganze entweder z.B. ab Zeile 500
LG
Michael
Anzeige
AW: Zelle in nächste Zeile kopieren
17.05.2017 21:50:53
Gerd
Hallo Peter!
Sub LP()
Dim aVnt As Variant, L As Long, Z As Byte
With Cells(2, 1).Resize(499)
aVnt = .Value
For L = 2 To 499
If aVnt(L, 1) = "" Then
aVnt(L, 1) = aVnt(L - 1, 1)
Z = Z + 1
If Z = 50 Then Exit For
Else: Z = 0
End If
Next
.Value = aVnt
End With
End Sub
Gruß Gerd
AW: ...und auch noch als Array-Variante...
18.05.2017 09:18:41
Michae
...
Sub c()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim r As Range: Set r = Ws.Range("A2:A500")
Dim a, i&, v
Application.ScreenUpdating = False
a = r
For i = LBound(a) To UBound(a)
If a(i, 1)  "" Then
v = a(i, 1)
Else: a(i, 1) = v
End If
Next i
r.Resize(UBound(a), 1) = a
Erase a
Set Wb = Nothing
Set Ws = Nothing
Set r = Nothing
End Sub
LG
Michael
Anzeige
AW: ...und auch noch als Array-Variante...
18.05.2017 09:23:17
Lesepeter
Danke Michael, danke Gerd!
Eure Lösungen funktionieren super!
Klar ;-), Danke für die Rückmeldung, owT
18.05.2017 09:29:20
Michae

321 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige