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

aktive Zeile X-Mal kopieren?

Forumthread: 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
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
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
Anzeige
AW: einfach erweitern ...
05.03.2012 20:52:55
Selma
Funktioniert! DANKE!
Gruß,
Selma

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige