在启用自动筛选function的情况下将一行复制并添加到工作表的末尾，并在“要复制的行”

更新 – 替代解决scheme不幸的是没有答案我的问题，我需要继续与该项目。 我研究了一些我之前做的代码，并决定使用它。 我发现的解决scheme比用户djbrettbuild议的解决scheme要精简，但是它的工作原理。 我添加了一个额外的macros，macros可以继续计数。 对于那些有兴趣，请参阅下面的代码。

我希望，如果我对VBA的认识不断增长，我将为下面提出的问题find一个解决scheme。

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 

我想做什么 这个问题是对我以前提出的一个问题的跟进，而且这个问题得到了回答。 目标仍然是相同的，我希望能够通过使用button添加行。 现在我可以添加行，即使在使用Autofilter时也是如此。 但是，我遇到了一个麻烦。

由于我真的不知道发生了什么，我提供了一个链接到示例表[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中，需要复制的行中有一个条目/公式。 这个公式需要在每个新条目的所有后续行中出现。 但结果不是我除了。 行被复制，工作。 但是“跟随数字”被放在了新的一排。 看到下面的图片时，它出现错误： 。

看到下面的图片我想看（注意隐藏/自动过滤的行）：

我已经尝试了几个解决scheme之间的改变加起来的数字代码不同的偏移量，但没有奏效。 当我使用不同偏移量的自动filter时，代码不起作用。 看下面的例子。

 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 

复制。 由于我不知道哪里出了问题，所以我提供了一个样本工作手册来掩饰正在发生的事情。 我相信这与“被复制的行”中单元格的内容有关，但是对于我来说，怎么样和为什么是一个神秘的东西。 当摆弄这个问题时，我有时会有一张工作表。 但是当我试图复制我所做的时，它又被打破了。

解决scheme。 我希望能够按照我以前的问题要求添加一个新的行。 如果在“要复制的行”中没有公式或者有些东西，那么它是部分工作的。 “AddRowActiviteiten”certificate这个解决scheme可以工作。

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

我希望能够更具体地确定问题所在的方向。 如果事情不清楚，随时向我发射任何你可能有的问题。

亲切的问候，

西蒙