Excel 在表的底部插入新行和删除顶行时出现问题

我的文件看起来像附件。以下代码段试图仅在我未指定的工作表上插入行。这将从B3单元开始，并逐步向下。因此，它在B34处插入一行，因为这是第一个新行，并将删除B3行，因此范围将以指数形式继续

我相信代码几乎可以做到这一点。我需要完成上述内容，但也需要将单元格B4中显示的公式作为公式复制到B5，然后将B4粘贴为值。这样，当运行另一个更新工作簿的宏时，只有带有公式的值才会更改，而不会更改前几周的值。我有图表查看这个范围，因此每次运行不同的宏时，最新的值都会显示，并且在范围和后续图表中会显示一个新值。希望这有意义

子插入新行（）
将遥感器作为工作表
用于此工作簿中的每个rs。工作表
如果rs.name“3110”和rs.name“数据”和rs.name“批发”和rs.name“零售”和rs.name“枢轴1”和rs.name“枢轴3”和rs.name“枢轴4”和rs.name“枢轴5”和rs.name“枢轴6”和rs.name“枢轴7”和rs.name“枢轴8”和rs.name“枢轴9”和rs.name“枢轴10”和rs.name“枢轴11”，则
rs.name=rs.Range（“B3:B”）.值
下一个rs
终点
“去最后一间牢房
单元格（Rows.Count，1）。结束（xlUp）。偏移量（1，0）。选择
'从上面的单元格复制公式
行（Selection.Row-1）。复制
行（Selection.Row）。插入移位：=xlDown
将ws设置为工作表
对于ActiveWorkbook.Worksheets中的每个ws
ws.Range（“2:2”）。删除
下一个ws
端接头

我的建议：

Sub INSERT_NEW_ROWS()
Dim rs As Worksheet
For Each rs In ThisWorkbook.Worksheets
   If rs.Name <> "3110" And rs.Name <> "Data" And rs.Name <> "Wholesale" And rs.Name 
<> "Retail" And rs.Name <> "Pivot 1" And rs.Name <> "Pivot 2" And rs.Name <> "Pivot 
3" And rs.Name <> "Pivot 4" And rs.Name <> "Pivot 5" And rs.Name <> "Pivot 6" And 
rs.Name <> "Pivot 7" And rs.Name <> "Pivot 8" And rs.Name <> "Pivot 9" And rs.Name <> 
"Pivot 10" And rs.Name <> "Pivot 11" Then

' LastRow in column A
LastRowa = rs.Cells(rs.Rows.Count, "A").End(xlUp).Row
' LastRow in column B
LastRowb = rs.Cells(rs.Rows.Count, "B").End(xlUp).Row    

'Copy paste the last row, based on what's in column A in the next empty row

rs.Cells(LastRowa, 2).EntireRow.Copy
rs.Cells(LastRowa + 1, 1).PasteSpecial xlPasteFormulas

'Change the formula of the last cell in column  B into a value
rs.Cells(LastRowb, 2).Copy
rs.Cells(LastRowb + 1, 2).PasteSpecial xlPasteFormulas
rs.Cells(LastRowb, 2).Value = rs.Cells(LastRowb, 2).Value
End If
Next rs

End Sub

子插入新行（）
将遥感器作为工作表
用于此工作簿中的每个rs。工作表
如果rs.名称“3110”和rs.名称“数据”和rs.名称“批发”和rs.名称
“零售”和rs.名称“Pivot 1”和rs.名称“Pivot 2”和rs.名称“Pivot
3“和rs.名称“枢轴4”和rs.名称“枢轴5”和rs.名称“枢轴6”和
rs.名称“Pivot 7”和rs.名称“Pivot 8”和rs.名称“Pivot 9”和rs.名称
“Pivot 10”和rs。然后命名为“Pivot 11”
'A列中的最后一行
LastRowa=rs.Cells（rs.Rows.Count，“A”）.End（xlUp）.Row
'列B中的最后一行
LastRowb=rs.Cells（rs.Rows.Count，“B”）.End（xlUp）.Row
'复制粘贴最后一行，基于下一空行A列中的内容
rs.Cells（LastRowa，2）.EntireRow.Copy
rs.Cells（LastRowa+1,1）.粘贴特殊XLPaste公式
'将B列中最后一个单元格的公式更改为值
rs.Cells（LastRowb，2）。复制
rs.单元格（LastRowb+1,2）.粘贴特殊公式
rs.Cells（LastRowb，2）.Value=rs.Cells（LastRowb，2）.Value
如果结束
下一个rs
端接头

这看起来很像我使用的滚动周期图。如果这些值是公式派生的（或者可以通过查找），我将维护一个主表，其中包含所有数据，并且只需在图表表中使用一个公式，从主表中查找最大日期，并将其用作日期列中滚动期间的最后一个日期。然后，上面的所有行与上面的行仅相差-1。然后，当您添加数据时，它会自动更新，而无需添加/删除行。这是一个好主意……。我有42个不同的数据项，加上滚动30天，因此有1260个可能的数据项和公式。考虑到这里的人使用笔记本电脑，它很可能会掉下来并死亡，因此我尝试使用宏路径。如果没有那么多数据项，我会同意你的观点，伙计：）谢谢你的回复！将数据放在Access/sql数据库中，然后编写一个查询，只将最近的滚动期月份拉入工作簿。或者最好还是在数据库中生成最终输出，并以您需要的格式只输出您需要的内容。感谢Lambik，现在部分工作，非常感谢！我只需要它复制整行，以便所有数据表现在都有一个新行，而不仅仅是B列请？兰比克非常感谢我的朋友，非常感谢！我只需要做一件事，那就是将公式复制到其中一列的位置，在本例中，将B3到B4作为公式，然后将上面的单元格粘贴为值。这是我可以合并到上面的程序中还是作为一个单独的子程序运行？谢谢我的印象是这样做了。发生的情况是，最后一行被复制粘贴（公式）到第一个新的空白行。随后使用´rs.Cells（LastRow，2）.Value=rs.Cells（LastRow，2）.Value´，最后一行B中的公式替换为其值。如果不是，请详细说明现在发生了什么，我的测试按预期进行Hey Lambik，感谢您的回复。它增加了最下面的一行，这是完美的，我现在需要取它存在的公式，在这里是单元格b3，并将它复制到下面的下一行，即B4。然后我需要粘贴上面的行（B3），这将成为一个值，而B4现在将有公式。下次执行此操作时，B5现在将具有公式，B4将粘贴为值。抱歉搞混了，请检查这是否是你的意思，我有点困惑，但我想这是你想要得到的。如果不正确，请检查代码的功能，并清楚地解释代码无法正常工作的原因。如果答案正确，请标记我的答案，谢谢，

Sub INSERT_NEW_ROWS()
Dim rs As Worksheet
For Each rs In ThisWorkbook.Worksheets
   If rs.Name <> "3110" And rs.Name <> "Data" And rs.Name <> "Wholesale" And rs.Name 
<> "Retail" And rs.Name <> "Pivot 1" And rs.Name <> "Pivot 2" And rs.Name <> "Pivot 
3" And rs.Name <> "Pivot 4" And rs.Name <> "Pivot 5" And rs.Name <> "Pivot 6" And 
rs.Name <> "Pivot 7" And rs.Name <> "Pivot 8" And rs.Name <> "Pivot 9" And rs.Name <> 
"Pivot 10" And rs.Name <> "Pivot 11" Then

' LastRow in column A
LastRowa = rs.Cells(rs.Rows.Count, "A").End(xlUp).Row
' LastRow in column B
LastRowb = rs.Cells(rs.Rows.Count, "B").End(xlUp).Row    

'Copy paste the last row, based on what's in column A in the next empty row

rs.Cells(LastRowa, 2).EntireRow.Copy
rs.Cells(LastRowa + 1, 1).PasteSpecial xlPasteFormulas

'Change the formula of the last cell in column  B into a value
rs.Cells(LastRowb, 2).Copy
rs.Cells(LastRowb + 1, 2).PasteSpecial xlPasteFormulas
rs.Cells(LastRowb, 2).Value = rs.Cells(LastRowb, 2).Value
End If
Next rs

End Sub