有没有更简单的方法来重复插入行的列表底部？

我试图通过单击button（Excel VBA）将一行添加到列表的底部。 这是最简单的方法吗？ 如果是，则该代码不工作，select“B37”后停止。 任何build议将是有益的。 谢谢！！

主题1：xxxxx – 主题1：xxxxx – 主题1：xxxxx
主题2：xxxxx – 主题2：xxxxx – 主题2：xxxxx
主题3：xxxxx至主题3：xxxxx至主题3：xxxxx
主题4：xxxxx – …………….. xxxxx – …………….. xxxxx
主题5：xxxxx – 主题4：xxxxx – …………….. xxxxx
…………………………主题5：xxxxx – 主题4：xxxxx
………………………………………….. ……….主题5：xxxxx

Sub ReferenceDocAddiditon() ' ' ReferenceDocAddiditon Macro ' ' ' Range("B37").Select If ActiveCell = "" Then Range("B38").Select If ActiveCell = "" Then Range("B39").Select If ActiveCell = "" Then Range("B40").Select If ActiveCell = "" Then Range("B41").Select If ActiveCell = "" Then Range("B42").Select If ActiveCell = "" Then Range("B43").Select If ActiveCell = "" Then Range("B44").Select If ActiveCell = "" Then Range("B45").Select If ActiveCell = "" Then Range("B46").Select If ActiveCell = "" Then ElseIf ActiveCell <> "" Then Rows("45:45").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B44").Select ElseIf ActiveCell <> "" Then Rows("44:44").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B43").Select ElseIf ActiveCell <> "" Then Rows("43:43").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B42").Select ElseIf ActiveCell <> "" Then Rows("42:42").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B41").Select ElseIf ActiveCell <> "" Then Rows("41:41").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B40").Select ElseIf ActiveCell <> "" Then Rows("40:40").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B39").Select ElseIf ActiveCell <> "" Then Rows("39:39").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B38").Select ElseIf ActiveCell <> "" Then Rows("38:38").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B37").Select ElseIf ActiveCell <> "1" Then Rows("37:37").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("B36").Select ElseIf ActiveCell <> "" Then Rows("35:37").Select Selection.EntireRow.Hidden = False End If End If End If End If End If End If End If End If End If End If 

Answer 1

我不能说出你想做的所有事情，但我可以告诉你，这会做什么。

无需select任何单元格，除了在macros的末尾将控制权返回到新行的列A，只需插入，即可保留任何格式。

可能有一个更简单的方法来做到这一点，但我的大脑是这样工作的。 随意寻找其他的解决scheme，或适应这个，以满足您的需求，如果不是正确的。 代码中的注释应该提供有关正在发生的事情的信息。

testing：请参阅图片

 Sub InsertRowAtEnd() Dim lastRow As Long Dim lastCol As Long Dim sheet As String sheet = "Sheet1" 'Name your sheet here. lastRow = Sheets(sheet).Range("A" & Rows.Count).End(xlUp).row 'Get last Row & col lastCol = Sheets(sheet).Cells(2, Columns.Count).End(xlToLeft).Column Sheets(sheet).Cells(lastRow, 1).EntireRow.Insert 'Insert a new row before the last row For lCol = 1 To lastCol 'Copy the last row to the inserted row Sheets(sheet).Cells(lastRow, lCol) = Sheets(sheet).Cells(lastRow + 1, lCol) Sheets(sheet).Cells(lastRow + 1, lCol).ClearContents 'erase the old last row Next lCol Sheets(sheet).Cells(lastRow + 1, 1).Select 'Return focus to the new cell A(row) End Sub