Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Wenn dann Zelle 5x kopieren in nächste Leere

Forumthread: VBA Wenn dann Zelle 5x kopieren in nächste Leere

VBA Wenn dann Zelle 5x kopieren in nächste Leere
29.07.2014 08:57:02
Max
Hallo *,
ich würde mich freuen, wenn ihr mir weiterhelfen könnt.
Wenn in Zelle A1 beispielsweise etwas steht, dann würde ich gerne die Zellen A1,B1,D1,E1 und G1 auf ein neues Tabellenblatt kopieren. Aber nicht nur einmal, sondern 5x untereeinander.
In Zeile 2 meiner Tabelle steht natürlich auch ein Wert, somit sollen dann auch A2, B2, D2, E2 und G2 5x auf das neue Tabellenblatt kopiert werden, allerdings in die ersten freien Zeilen.
Könnt ihr mir dafür eine Excel-Schleife vorschlagen?
Grüße,
Max

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Wenn dann Zelle 5x kopieren in nächste Leere
29.07.2014 11:05:06
Rudi
Hallo,
Sub abc()
Dim wsAkt As Worksheet, wsNeu As Worksheet
Dim rngC As Range
Dim arrTmp(1 To 5, 1 To 5), i As Integer
Application.ScreenUpdating = False
Set wsAkt = ActiveSheet
Set wsNeu = Worksheets.Add(after:=wsAkt)
With wsAkt
For Each rngC In .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
If rngC  "" Then
For i = 1 To 5
arrTmp(i, 1) = rngC.Offset(, 0)
arrTmp(i, 2) = rngC.Offset(, 1)
arrTmp(i, 3) = rngC.Offset(, 3)
arrTmp(i, 4) = rngC.Offset(, 4)
arrTmp(i, 5) = rngC.Offset(, 6)
Next
wsNeu.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arrTmp), UBound(arrTmp, 2)) _
= arrTmp
End If
Next
End With
wsNeu.Rows(1).Delete
End Sub

Gruß
Rudi
Anzeige

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige