Zellen kopieren VBA Code

Sub nächsterTag() Dim rngDest As Range Dim rngSel As Range On Error Resume Next Set rngSel = Selection Set rngDest = ActiveCell.End(xlDown).Offset(1, 0) If Not rngDest Is Nothing Then rngSel.Copy rngDest rngDest.Offset(0, 1) = Date Else Set rngDest = ActiveCell.Offset(1, 0) ActiveCell.Copy rngDest rngDest.Offset(0, 1) = Date End If End Sub Vielen Dank dafür nochmal:-) Jetzt zu meinen Fragen. Ist es möglich den Code so umzuschreiben,dass das Datum neben jedem kopierten Feld steht? Wie müsste der Code aussehen ,wenn man die kopierten Bereiche immer auf die oberste Zeile setzt und somit alles andere nach unten rückt ?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub nächsterTag() Dim rngSel As Range Dim lz As Long On Error Resume Next Set rngSel = Selection lz = Cells(Rows.Count, 1).End(xlUp).Row Range(Cells(1, 1), Cells(lz, 2)).Cut Destination:=Range("A2") ActiveCell.Offset(1, 0).Select rngSel.Copy Range("A1") ActiveCell.Offset(0, 1) = Date End Sub

Sub nächsterTag() Dim lz, z As Long On Error Resume Next a = Selection.Rows.Count lz = Cells(Rows.Count, 1).End(xlUp).Row Range(Cells(1, 1), Cells(lz, 2)).Cut Destination:=Cells(a + 1, 1) ActiveCell.Offset(a, 0).Select ActiveCell.Range(Cells(1, 1), Cells(a, 1)).Select Selection.Copy Range("A1") For z = 0 To a ActiveCell.Offset(z, 1) = Date Next z End Sub

Sub nächsterTag() Dim lz, z, c As Long a = Selection.Rows.Count b = Range("A1").End(xlDown).Row lz = Cells(Rows.Count, 1).End(xlUp).Row Range(Cells(1, 1), Cells(lz, 2)).Cut Destination:=Cells(a + 1, 1) ActiveCell.Offset(a, 0).Select ActiveCell.Range(Cells(1, 1), Cells(a, 1)).Copy Cells(b, 1) z = Range("A1").End(xlDown).Row For c = z To z + a Cells(c, 2) = Date Next c End Sub

Mesch Beni du bist ja ein richtiger Workoholic..wahnsinn!
Dank für die prompte Antwort.
Leider funktioniert der Code noch nicht so ganz.
Erklärung zum Bild
Die blau gefärbten Zellen symbolisieren die Markierung(unabhängige Anzahl... im Bild sind es jetzt mal gerade drei)
Die sollen per Code kopiert werden und direkt drüber gesetzt werden (Im Bild der gelbe Bereich ...also weil blau 3 zellen ist gelb auch drei zellen)und in die B zeile daneben soll noch das aktuelle Datum eingefügt werden.
Das ganze soll dann praktisch das komplette Formular nach unten verschieben und zwar genau um die Zeilen ,die man markiert(kopiert)hat.
Der Kopf des Blattes sollte dabei nicht verändert werden.
Die älteren Zellen müssen auch ihre Information behalten.
Dank für die massige Arbeit die du leistest Beni
Gruß seadog2000

Sub nächsterTag() Dim lz, z, c As Long a = Selection.Rows.Count b = Selection.End(xlUp).Row lz = Cells(Rows.Count, 1).End(xlUp).Row Range(Cells(b, 1), Cells(lz, 2)).Cut Destination:=Cells(b + a, 1) ActiveCell.Offset(a, 0).Select ActiveCell.Range(Cells(1, 1), Cells(a, 1)).Copy Cells(b, 1) z = Selection.End(xlUp).Row For c = z To z + a - 1 Cells(c, 2) = Date Next c End Sub

Hallo,
bei mir fuktioniert es bestens, eine kleine Erklärung dazu.
Zum Zweiten: probieren/üben,probieren/üben,probieren/üben,probieren/üben,.............
Gruss Beni


Sub nächsterTag1()
Dim lz, z, c As Long
'a ermittelt die Anzahl markierten Zeilen
a = Selection.Rows.Count
'b ermittelt die letzte gefüllte Zelle von der Markierung aus Richtung nach oben, vor einer Leerzelle
' in deinen Fall ist das die Zeile 11
b = Selection.End(xlUp).Row
'lz ermittelt die unterste gefüllte Zelle, in deinen Fall ist das die Zeile 26
lz = Cells(Rows.Count, 1).End(xlUp).Row
'hier wird der ganze gefüllte Bereich nach unten geschoben, b - lz
Range(Cells(b, 1), Cells(lz, 2)).Cut Destination:=Cells(b + a, 1)
'die Markierung geht so viele Zeilen nach unten, wie makiert worden sind
ActiveCell.Offset(a, 0).Select
'der Bereich wird kopiert und an die ursprünglich oberste Stelle gesetzt, b
ActiveCell.Range(Cells(1, 1), Cells(a, 1)).Copy Cells(b, 1)
'mit z wird nochmals die letzte gefüllte Zelle von der Markierung aus Richtung nach oben, vor einer Leerzelle
z = Selection.End(xlUp).Row
'mit der For-Schleife werden die Datums eingefügt
For c = z To z + a - 1
Cells(c, 2) = Date
Next c
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)

Zellen kopieren VBA Code

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