在启用自动过滤器的情况下将行复制并添加到工作表末尾，并在“待复制行”

Question

更新 - 替代解决方案 不幸的是我的问题没有答案，我需要继续这个项目。我查看了之前制作的一些代码并决定使用它。我找到的解决方案不如用户djbrett建议的解决方案，但它的工作原理。我添加了一个额外的行，宏可以从中继续计数。对于有兴趣的人，请参阅下面的代码。

我希望如果我对VBA的了解越来越多，我将找到解决下面问题的解决方案。

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

我想做什么。 这个问题是对我提出的previous question的后续问题，并得到了回答。目标仍然相同，我希望能够使用按钮添加行。现在我可以添加行，即使我使用自动过滤器也是如此。然而，我遇到了一个障碍。

由于我不知道发生了什么，我提供了一个示例表[URL-Removed]的链接。

代码。 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

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

正如您所看到的，它们基本相同。

问题。 在Riskregister中，行中有一个需要复制的条目/公式。此公式需要存在于每个新条目的所有后续行中。但结果并不是我的意思。 该行被复制，这是有效的。但是“跟随号码”被放置在一个新行上。出现错误时请参见下图：

请参阅下图，了解我想看到的内容（注意隐藏/自动过滤的行）：

我在更改代码中尝试了几种解决方案，以便将数字加到不同的偏移量，但这不起作用。当我使用具有不同偏移量的自动过滤器时，代码不起作用。请参阅下面的示例。

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

要复制。 由于我不知道哪里出了问题，我提供了一个示例工作簿来消除正在发生的事情。我认为它与“待复制行”中的单元格内容有关，但是对我来说如何以及为什么是一个神秘的东西。当摆弄这个问题时，我有时会有一张工作表。但当我试图复制我所做的事情时，又被打破了。

解决方案。 我希望能够按照上一个问题的要求添加新行。如果“要复制的行”中没有公式或某些内容，它部分有效。 “AddRowActiviteiten”证明此解决方案可以正常工作。

要测试我总是检查我是否能够自动过滤状态。添加一些行并将最新添加的行的状态设置为“Ja”或“Nee”。过滤并添加更多行。

我希望我能更具体地确定问题所在的方向。如果事情不清楚，请随时向我提出任何问题。

亲切的问候，

西蒙