Excel VBA添加新行脚本不根据button的位置添加行

我有一个Excel电子表格，我已经添加了一个button，我想单击一个button，拿一个该行的副本，然后复制下面。

由于某种原因，它似乎没有select我点击button的行，但是光标所在的位置意味着复制了错误的行。

有没有什么办法可以改变下面的button被按下的地方？

Sub InsertRows() Dim x As Integer x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1) If x = False Then Exit Sub ActiveCell.EntireRow.Copy Range(ActiveCell, ActiveCell.Offset(x - 1, 0)).EntireRow.Insert Shift:=xlDown Application.CutCopyMode = False End Sub 

提前谢谢了

人族

编辑

我的最终解决scheme是托马斯的帮助。

略有不同的是，这允许button自己也被复制以及行。

 Sub InsertRows() Dim iRow As Integer Dim x As Integer Dim i As Integer x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1) iRow = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row If x = False Then Exit Sub For i = 0 To (x - 1) 'Range(ActiveCell, ActiveCell.Offset(x - 1, 0)).EntireRow.Insert Shift:=xlDown Range("A" & iRow).EntireRow.Copy Range("A" & iRow + 1 + i).EntireRow.Insert Shift:=xlDown Next i Application.CutCopyMode = False End Sub 

Answer 1

使用这个来获得你刚刚点击的button的行：

 ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row 

我真的不明白你想用你的msgbox收集一个偏移量。 所以这里的代码是激发你所问的问题，即复制button所在的行，在右下方的行中：

 Sub Button1_Click() Dim iRow As Integer iRow = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row Range("A" & iRow).EntireRow.Copy Range("A" & iRow + 1).PasteSpecial End Sub 

---

编辑：如果你想复制几次只是这样做：

 Sub Button1_Click() Dim iRow As Integer Dim x As Integer Dim i As Integer x = Application.InputBox("Number of Rows", "Number of Rows", Type:=1) iRow = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row For i = 0 To (x - 1) Range("A" & iRow).EntireRow.Copy Range("A" & iRow + 1 + i).PasteSpecial Next i End Sub