Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1252to1256
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

aktive Zeile X-Mal kopieren?

aktive Zeile X-Mal kopieren?
Selma
Hallo zusammen,
ich möchte per VBA die aktive Zeile nach unten kopieren und zwar so oft wie der Zahl in der Spalte B dieser Zeile.
Danach soll die Zeile (die vor dem Kopieren aktiv war) gelöscht werden!
Wie mache ich das bitte?
Viele Grüße,
Selma

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
warum nicht (X-Mal) -1 ?
05.03.2012 16:49:50
Matthias
Hallo Selma
https://www.herber.de/bbs/user/79218.xls
... aber warum x-mal kopieren und dann 1x löschen?
Dann reicht doch einmal weniger kopieren als in Spalte (B) steht
Achtung
Ich habe noch keine Fehlerroutine in die Datei eingebaut,
Die gehört aber zwingend mit rein, für den Fall das in B z.B. Text steht
Ich möchte erst wissen, ob das so passt.
Gruß Matthias
AW: warum nicht (X-Mal) -1 ?
05.03.2012 19:02:02
Selma
Hallo Matthias,
(X-Mal) -1 geht auch.
Ich habe vergessen zu schreiben, dass wenn die Zeilen kopiert sind,
dann soll in allen kopierten Zeilen + Ursprungszeile in der Spalte B der Wert auf "1" gesetzt werden (siehe Bild).
Das Bild habe ich erstellt und sehe jetzt :-), dass im Bild rechts eine Zeile zu viel ist.
Es sollen insgesamt 6 Zeilen sein, sind aber 7.

Userbild
Viele Grüße,
Selma
Anzeige
also ist Dein Poblem gelöst ? oT
05.03.2012 19:13:07
Matthias
AW: also ist Dein Poblem gelöst ? oT
05.03.2012 19:20:43
Selma
Hallo Matthias,
noch nicht.....
Das Bild (vorher / nachher) habe ich gemacht, wie ich es haben möchte.
Wobei im Bild rechts eine Zeile zur Zeit zu viel kopiert ist.
Beispiel:
In B16 steht 6. Also 6-1=5 Mal nach unten kopieren, dann in B16:B21 = 1 eintragen. So soll es sein :-)
Viele Grüße,
Selma
ok dann z.B. so ...
05.03.2012 19:40:34
Matthias
Hallo Selma
Achtung
Ich habe noch immer keine FehlerRoutine drin !
Sub Selma()
Dim zZ&, MyRow&, x&
MyRow = ActiveCell.Row
zZ = Cells(ActiveCell.Row, 2)
Application.ScreenUpdating = False
Cells(MyRow, 2) = 1
For x = 1 To zZ - 1
Rows(ActiveCell.Row).Copy
Rows(MyRow + 1).Insert Shift:=xlDown
Cells(MyRow, 2) = 1
Application.CutCopyMode = False
Next
Cells(MyRow, 2) = 1
Application.ScreenUpdating = False
End Sub
Ich bin aber nicht zufrieden damit.
Was soll passieren, wenn Text oder 0 (Null) in der Zelle in Spalte (B) steht ?
Gruß Matthias
Anzeige
AW: ok dann z.B. so ...
05.03.2012 19:46:54
Selma
Hallo Matthias,
ich habe es getestet und es funktioniert wie gewollt. Danke!
Wenn in Spalte (B) der Text oder 0 steht, dann soll das Makro nicht ausgeführt werden.
Viele Grüße,
Selma
probiers mal so ...
05.03.2012 20:10:10
Matthias
Hallo Selma
Option Explicit
Sub Selma()
Dim zZ&, MyRow&, x&
MyRow = ActiveCell.Row
zZ = Cells(ActiveCell.Row, 2)
If IsNumeric(Cells(MyRow, 2)) And Not IsDate(Cells(MyRow, 2)) Then
Application.ScreenUpdating = False
Cells(MyRow, 2) = 1
For x = 1 To zZ - 1
Rows(ActiveCell.Row).Copy
Rows(MyRow + 1).Insert Shift:=xlDown
Cells(MyRow, 2) = 1
Application.CutCopyMode = False
Next
Cells(MyRow, 2) = 1
Application.ScreenUpdating = False
End If
End Sub
Gruß Matthias
Anzeige
AW: probiers mal so ...
05.03.2012 20:21:55
Selma
Hallo Matthias,
in der Datei, die Du angehängst hast steht in der Zelle B4 z.B. "irgendwas …" da habe ich das Makro ausgeführt und es kommt Meldung: Laufzeitfehler '13' Typen unverträglich und das Makro bleibt hier: zZ = Cells(ActiveCell.Row, 2) stehen.
Wenn in Spalte B eine 0 steht, dann wird der Wert von 0 auf 1 geändert. Das soll es nicht. :-)
Viele Grüße,
Selma
tausch die 2 Zeilen
05.03.2012 20:28:25
Matthias
Hallo Selma
Ja, hatte ich noch nicht angepasst
Du musst 2 Zeilen tauschen
Option Explicit
Sub Selma()
Dim zZ&, MyRow&, x&
MyRow = ActiveCell.Row
If IsNumeric(Cells(MyRow, 2)) And Not IsDate(Cells(MyRow, 2)) Then
zZ = Cells(ActiveCell.Row, 2) Application.ScreenUpdating = False
Cells(MyRow, 2) = 1
For x = 1 To zZ - 1
Rows(ActiveCell.Row).Copy
Rows(MyRow + 1).Insert Shift:=xlDown
Cells(MyRow, 2) = 1
Application.CutCopyMode = False
Next
Cells(MyRow, 2) = 1
Application.ScreenUpdating = False
End If
End Sub

Anzeige
Tausch die 2 Zeilen
05.03.2012 20:38:29
Matthias
Hallo
Da war wohl irgenwas was verutscht ...
Option Explicit
Sub Selma()
Dim zZ&, MyRow&, x&
MyRow = ActiveCell.Row
If IsNumeric(Cells(MyRow, 2)) And Not IsDate(Cells(MyRow, 2)) Then
zZ = Cells(ActiveCell.Row, 2)
Application.ScreenUpdating = False
Cells(MyRow, 2) = 1
For x = 1 To zZ - 1
Rows(ActiveCell.Row).Copy
Rows(MyRow + 1).Insert Shift:=xlDown
Cells(MyRow, 2) = 1
Application.CutCopyMode = False
Next
Cells(MyRow, 2) = 1
Application.ScreenUpdating = False
End If
End Sub
Gruß Matthias
AW: Tausch die 2 Zeilen
05.03.2012 20:42:50
Selma
Hallo Matthias,
wenn in der Spalte B eine 0 steht, dann wird der Wert von 0 auf 1 geändert. Das stimmt noch nicht.
Bei 0 in der Spalte soll keine Aktion ausgeführt werden.
Viele Grüße,
Selma
Anzeige
einfach erweitern ...
05.03.2012 20:50:14
Matthias
Hallo Selma
If IsNumeric(Cells(MyRow, 2)) And Not Cells(MyRow, 2) = 0 And Not IsDate(Cells(MyRow, 2)) Then
Gruß Matthias
AW: einfach erweitern ...
05.03.2012 20:52:55
Selma
Funktioniert! DANKE!
Gruß,
Selma

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige