Anzeige
Archiv - Navigation
1488to1492
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

Kopierloop

Kopierloop
04.05.2016 14:31:45
Michel
Hallo zusammen
Ich bin ein VBA-Anfänger und habe eine Frage zu einem Kopierloop:
Konkret möchte ich einen Zellbereich (Zellen B3; D3; E3; F3) an einen anderen Ort kopieren und dies mit der nächsten Zeile solange wiederholen lassen, bis die Zeile 100 erreicht ist. Der Loop als solches funktioniert, leider aber nicht die "variable" Zeile des zu kopierenden Bereichs. Hier mal mein Versuch der leider nicht klappt:
Sub Beispiel()
Range("B2").Select
Do
ActiveCell.Offset(1, 0).Activate
Dim x As String
x = ActiveCell.Address
ActiveCell.Offset(1, 0).Activate
Dim RaBereich As Range
Set RaBereich = Union(Range("Cells(AktiveCell.Row,2)"), Range("Cells(AktiveCell.Row,4)"),   _
_
Range("Cells(AktiveCell.Row,5)"), Range("Cells(AktiveCell.Row,6))"))
RaBereich.Select
Selection.Copy
Range("L1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Blattname").Select
Range(x).Select
Loop Until ActiveCell.Row = "100"
End Sub

Wer kann mir weiterhelfen?
Schon mal Danke und Gruss
Sigi

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

Betreff
Datum
Anwender
Anzeige
AW: Kopierloop
04.05.2016 15:40:40
ChrisL
Hi Sigi
Ich denke das Grundproblem liegt darin, dass du zwischen Zahl und Text unterscheiden musst. Texte müssen immer mit Anführungszeichen umklammert werden, aber Zahlen nicht. Z.B.
falsch: ActiveCell.Row = "100"
richtig: ActiveCell.Row = 100
AktiveCell gibt es übrigens nicht ;)
Da du auf Select verzichten solltest und der Loop in der Folge einen Zähler benötigen würde, geht es einfacher, wenn du eine For-Next Schleife verwendest.
Sub t()
Dim i As Long
Range("B3,D3:F3").Copy
For i = 1 To 100
Cells(Rows.Count, 12).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
Application.CutCopyMode = False
End Sub

Ein Variante ganz ohne Schleife wäre z.B.
Sub tt()
Dim letzteZeile As Long
letzteZeile = Cells(Rows.Count, 12).End(xlUp).Row + 1
Range(Cells(letzteZeile, 12), Cells(letzteZeile + 100, 12)) = Range("B3").Value
Range(Cells(letzteZeile, 13), Cells(letzteZeile + 100, 15)) = Range("D3:F3").Value
End Sub
cu
Chris

Anzeige
AW: Kopierloop
09.05.2016 08:52:50
Michel
Hallo Chris
Vielen Dank für deine Antwort. Ich habe mich wohl nicht ganz korrekt oder klar ausgedrückt. Es ist nicht nur der Bereich:
Range("B3,D3:F3").Copy
zu kopieren sondern dann auch die weiteren Zeilen:
Range("B4,D4:F4").Copy
Range("B5,D5:F5").Copy
usw. bis Zeile 100
Danke schon mal für die weitere Hilfe.
Gruss
Sigi

AW: Kopierloop
09.05.2016 09:34:01
ChrisL
Hi Sigi
Vielleicht so...
Sub t()
Range("L3:L100") = Range("B3:B100").Value
Range("M3:O100") = Range("D3:F100").Value
End Sub
cu
Chris

AW: Kopierloop
09.05.2016 10:35:11
Michel
Hallo Chris
Ja gute Idee, aaaaber....
Nachdem ich den Bereich B3,D3:F3 kopiert habe, möchte ich gleich anschliessend den Bereich C3:F3 kopieren (sorry, hab ich bis jetzt noch nicht gesagt...), dann kommt der Bereich B4,D4:F4 und C4:F4 usw. dran, deshalb hab ich an den Loop gedacht.
Also mit anderen Worten hab ich in den Ausgangszellen alle Informationen auf einer Zeile die ich im Zielbereich auf zwei Zeilen brauche....
Anbei ein Filebeispiel.
https://www.herber.de/bbs/user/105459.xlsx
Danke und Gruss
Sigi

Anzeige
AW: Kopierloop
09.05.2016 10:52:45
ChrisL
Hi Michael
Auf dein Beispiel bezogen so:
Sub t()
Dim iZeile As Long, tempZeile As Long
For iZeile = 5 To 100
tempZeile = ((iZeile - 5) * 2) + 5
Cells(tempZeile, 11) = Cells(iZeile, 2).Value
Cells(tempZeile + 1, 11) = Cells(iZeile, 3).Value
Range(Cells(tempZeile, 12), Cells(tempZeile + 1, 14)) = _
Range(Cells(iZeile, 4), Cells(iZeile, 6)).Value
Next iZeile
End Sub

cu
Chris

AW: Kopierloop
09.05.2016 11:16:57
Michel
Hallo Chris
Perfekt, funktioniert!
Vielen Dank!
Gruss
Sigi

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige