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
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.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ß MatthiasOption 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
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