Copying and adding a row to the end of the sheet w

Question

UPDATE - Alternative solution Unfortunately no answers to my problem and I needed to get on with the project. I looked into some code I made earlier and decided to work with that. The solution I found is less elagant than the one suggested by user djbrett, but it works. I added an extra line from which the macro can keep counting. For those interested, see the code below.

I hope that if my knowledge of VBA grows that I will find a solution for the question asked below.

Sub AddRowActiviteiten_NewAtEnd()
'Add's a new row at the end of the sheet.

Dim wsActiviteiten As Worksheet
Set wsActiviteiten = Sheets("Activiteiten")

DefType = "Daily"
DefStatus = "Open"
SheetEnd = "Stop"
DefIssue = "*****"
DefImpact = "*****"
DefPrio = "Laag"
MyDate = Date

'Verify that there is always a value of zero in A3
'wsActiviteiten.Range("A3").Value = "0"

If wsActiviteiten.Range("A4").Value = "1" Then

' Replaces some values in the "extra line" with content I prefer. 
LastRow = wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(-1, 0).Row

Cells(LastRow + 1, 2) = MyDate
Cells(LastRow + 1, 3) = DefType
Cells(LastRow + 1, 4) = DefStatus
Cells(LastRow + 1, 5) = DefIssue
Cells(LastRow + 1, 6) = DefImpact
Cells(LastRow + 1, 7) = DefPrio

'Copy the One Row To Rule Them All
wsActiviteiten.Range("A3:R3").Copy

'Paste the copied rule
wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)

'Stop the "copy-action"
Application.CutCopyMode = False

'Add up the trackingnumber with 1
LastNumber = wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Value
wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = LastNumber + 1
Cells(LastRow + 2, 2) = SheetEnd

'Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select

Else
'If there are no current records "rows" in the sheet, the code below adds it including the extra line to keep on counting. 
wsActiviteiten.Range("A3:R3").Copy
wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False

wsActiviteiten.Range("A4").Value = "1"

LastRow = wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(-1, 0).Row
Cells(LastRow + 1, 2) = MyDate
Cells(LastRow + 1, 3) = DefType
Cells(LastRow + 1, 4) = DefStatus
Cells(LastRow + 1, 5) = DefIssue
Cells(LastRow + 1, 6) = DefImpact
Cells(LastRow + 1, 7) = DefPrio

'Add extra row
wsActiviteiten.Range("A3:R3").Copy
wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll)
Application.CutCopyMode = False

LastNumber = wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Value
wsActiviteiten.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = LastNumber + 1
Cells(LastRow + 2, 2) = SheetEnd

ActiveCell.Offset(1, 4).Select


End If
End Sub

What do I want to do. This question is a follow-up on a previous question I asked and that was answered. The objective is still the same, I want to be able to add rows by using a button. Now I am able to add rows, even when I use the Autofilter. However, there is a snag I run into.

Since I don't really know what is happening, I have provided a link to an example sheet [URL-Removed].

The code.  The code for AddRowActiviteiten

 Sub AddRowActiviteiten_NewAtEnd()
'Add's a new row at the end of the sheet.


Dim wsActiviteiten As Worksheet
Set wsActiviteiten = Sheets("Activiteiten")

DefType = "Daily"
DefStatus = "Open"
DefIssue = "*****"
DefImpact = "*****"
DefPrio = "Laag"
MyDate = Date

'Copy the One Row To Rule Them All
wsActiviteiten.Range("A3:Q3").Copy

'Offset(y,x)
wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(1, -16).PasteSpecial (xlPasteAll)

'Stop the "copy-action"
Application.CutCopyMode = False

'Het volgnummer verhogen met 1
LastNumber = wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(0, -16).Value
wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(1, -16).Value = LastNumber + 1


'Insert default values
LastRow = wsActiviteiten.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(-1, 0).Row
Cells(LastRow + 1, 2) = DefType
Cells(LastRow + 1, 3) = DefStatus
Cells(LastRow + 1, 4) = DefIssue
Cells(LastRow + 1, 5) = DefImpact
Cells(LastRow + 1, 6) = DefPrio
Cells(LastRow + 1, 8) = MyDate

'Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select

End Sub

The code for AddRowRiskRegister

Sub AddRowRiskRegister_NewAtEnd()
'Add's a new row at the end of the sheet.

Dim wsRiskRegister As Worksheet
Set wsRiskRegister = Sheets("RiskRegister")


DefStatus = "Analyse"
DefCategory = "*****"
DefNabijheid = "*****"
DefImpact = "*****"
MyDate = Date


'Copy the One Row To Rule Them All
wsRiskRegister.Range("A3:N3").Copy
wsRiskRegister.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(1, -13).PasteSpecial (xlPasteAll)

'Stop the "copy-action"
Application.CutCopyMode = False

LastNumber = wsRiskRegister.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(0, -13).Value
wsRiskRegister.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(1, -13).Value = LastNumber + 1

'Insert default values

LastRow = wsRiskRegister.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(-1, 0).Row
Cells(LastRow + 1, 2) = MyDate
Cells(LastRow + 1, 3) = DefStatus
Cells(LastRow + 1, 4) = DefCategory
Cells(LastRow + 1, 5) = DefNabijheid
Cells(LastRow + 1, 6) = DefPrio
Cells(LastRow + 1, 8) = MyDate


'Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select

End Sub

As you can see they are basically the same.

The problem. In Riskregister there is a entry/formula in the row that needs to be copied. This formula needs to be present in all the subsequent rows for every new entry. But the result is not what I except. The row is copied, that works. But the "follow-numbers" are placed on a new row. See the image below for when it goes wrong: .

See the image below for what I want to see (notice the hidden/autofiltered rows):

I have tried several solutions among changing the code for adding up the numbers to a different offset, but that did not work. When I use the Autofilter with a different offset, the code does not work. See an example below.

LastNumber = wsRiskRegister.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(-1, -13).Value
wsRiskRegister.Range(Split(ActiveSheet.AutoFilter.Range.Address, ":")(1)).Offset(0, -13).Value = LastNumber + 1

To replicate.  Since I don't really know where things go wrong, I have provided a sample workbook to demontrate what is happening. I believe it has something to do with the contents of a cell in the "to be copied row", but how and why is a mysterie to me. When fiddling with this problem, I sometimes had a working sheet. But when I tried to replicate what I did, it was broken again.

The solution.  I want to be able to add a new row as requested in my previous question. It partly works if there is no formula or someting in the "to be copied row". The "AddRowActiviteiten" proves this solution can work.

To test I always check if I am able to Autofilter the status. Add some rows and set the status of the latest added row to "Ja" or "Nee". Filter that and add some more rows.

I wish I could be more specific to identify the direction where the problem lies. If things aren't clear, feel free to shoot me any question you might have.

Kind regards,

Simon