Copy last active cell in column and paste below with adding +1

[MSchädler]

I need help!
I have a macro that copies a specified row and pastes it one below the last active row.
The columnX is basically a counter (starting from 1).
I'm lookingfor a VBA command to add to my macro. The command will take the last active cellin column X, copy it and paste it one cell below and perform an addition of one (+1 =increment).
I have not been able to define that command. Do you havea solution?
Thank you for your help!
M.

Here is myexisting macro to copy paste;
Private SubCommandButton4_Click()
myCheck = MsgBox("edit line?", vbYesNo)
If myCheck = vbNo Then Exit Sub

Application.ScreenUpdating = False

ActiveCell.EntireRow.Copy
ActiveSheet.Range("S65536").End(xlUp).Offset(1,0).EntireRow.Select
Selection.Insert

Range("Q" & (ActiveCell.Row)).Value = Date

Application.ScreenUpdating = True

End Sub

 

[footoo]

Re: Help required to copy last active cell in column and paste below with adding +1

Private Sub CommandButton4_Click()
myCheck = MsgBox("edit line?", vbYesNo)
If myCheck = vbNo Then Exit Sub


Application.ScreenUpdating = False


rw = Range("S65536").End(xlUp).Row + 1
ActiveCell.EntireRow.Copy
Rows(rw).Insert
Cells(rw, "X").Value = Cells(rw - 1, "X") + 1


Range("Q" & rw).Value = Date


Application.ScreenUpdating = True


End Sub

 

[MSchädler]

Re: Help required to copy last active cell in column and paste below with adding +1

Hello Footoo
Thanks a lot for this first input. Your solution (macro) works as expected.

Now I have one last question. What is the command in the following macro to achieve the same result in column X?
Again the command should take the last active cell in column X, copy it and paste it one below and perform an addition of one (+1) increment.

Thanks for your help.
M.

That macro is:

Private Sub CommandButton3_Click()
Application.EnableEvents = False

myCheck = MsgBox("Neues Projekt erfassen?", vbYesNo)
If myCheck = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveSheet.Range("S65536").End(xlUp).EntireRow.Select
Selection.Copy
ActiveSheet.Range("S65536").End(xlUp).Offset(1, 0).EntireRow.Select
Selection.Insert
Range("Q" & (ActiveCell.Row)).Value = Date 'setzt aktuelles Datum

Application.EnableEvents = True


End Sub

 

[MSchädler]

Re: Help required to copy last active cell in column and paste below with adding +1

Hello Footoo

In the mean time I have come up with the following vba code for my second question. Maybe you can tell me if I'm correct or if you have a more efficient way to do this.
Thanks for your help.
Marc

my adapted vba code:

Private SubCommandButton3_Click()

Application.EnableEvents = False
Sheets("Uebersicht").UnprotectPassword:="XXX"

myCheck = MsgBox("new project?", vbYesNo)
If myCheck = vbNo Then Exit Sub

Application.ScreenUpdating = False

ActiveSheet.Range("S65536").End(xlUp).EntireRow.Select
Selection.Copy
ActiveSheet.Range("S65536").End(xlUp).Offset(1,0).EntireRow.Select
Selection.Insert

Range("X" & (ActiveCell.Row)).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1= "=R[-1]C+1"

Range("Q" & (ActiveCell.Row)).Value = Date

Intersect(Range("M:N,R:S,U:V,AH:AK,AM:BA"), ActiveCell.EntireRow).ClearContents

Application.ScreenUpdating = True
Application.EnableEvents = True

ActiveSheet.Range("S65536").End(xlUp).Offset(1,0).EntireRow.Select
Range("M" & (ActiveCell.Row)).Select

End Sub

 

[footoo]

Re: Help required to copy last active cell in column and paste below with adding +1

If it does what you want, I suggest you leave it as is.

The code could be tidied up but it won't result in any noticeable difference in run-time.

 

[MSchädler]

Re: Help required to copy last active cell in column and paste below with adding +1

I just wanted to say thank you for your help and for your reply.
Have a good weekend.
Marc