在新表中保留参考单元

我基本上是试图在一张纸上采取行动，在另一张纸上镜像。 在Sheet1上复制并粘贴A1到B1？ 在Sheet2上复制并粘贴A1到B1。 问题是，它总是需要参考活动单元格，我不知道如何将活动单元格的地址保存为可用的格式。

这就是我想用简单的英语来完成的情景：

1. 在Sheet1的单元格为ActiveCell的情况下，在Sheet2的单元格行上插入行（例如，如果Sheet1！A1是活动单元格，则在Sheet2行1下面插入行）。

2. 在Sheet1上：复制ActiveCell.Row并在ActiveCell.Row下面插入。

3. 在Sheet2上：执行相同的，但在Sheet2上的相应行，除了我想粘贴到我刚刚从第1步插入的行。所以，如果我复制Sheet1第1行，并将其插入第1步在第2步，我想复制Sheet2 Row 1并将其粘贴到步骤1的新行中。

4. 返回到Sheet1，使用InputBox从用户获取一个值，将该值插入Range（“D”＆（ActiveCell.Row））

我有这一切工作，除了Sheet2的一部分，它打破公式，如果我不能在我复制/插入Sheet1之前获得该行。 我已经手动完成了这些步骤，如果能够编码的话，这一切都可以工作。

Sub Button18_Click（）

Dim Row_Source As Range Dim WS As Worksheet, WS2 As Worksheet Dim Day_Num As String Dim Day_Dest As Range Dim PRL As String Dim Address As String Dim RowNum As Long Dim Cell As Range Set Cell = ActiveCell ' just in case you'll decide to give-up on the "bad practice" of using ActiveCell RowNum = Cell.Row Set WS = ThisWorkbook.Sheets("Protocols") Set WS2 = ThisWorkbook.Sheets("Formulas") With WS PRL = .Range("B" & RowNum).Value Day_Num = InputBox("Please enter a day number to add to: " & PRL, "Add New Day") If Day_Num <> "" Then Set Row_Source = .Rows(RowNum) End If End With With WS2 If Day_Num <> "" Then Row_Source.Offset(1).Insert Shift:=xlDown Application.CutCopyMode = False End If End With With WS If Day_Num <> "" Then Row_Source.Copy Row_Source.Offset(1).Insert Shift:=xlDown Application.CutCopyMode = False .Range("D" & RowNum + 1).Value = Day_Num End If End With With WS2 If Day_Num <> "" Then Set Row_Source = .Rows(RowNum) Row_Source.Copy Row_Source.Offset(1).Select Row_Source.PasteSpecial Application.CutCopyMode = False End If End With 

结束小组

Answer 1

您正在寻找类似下面的代码：

 Sub Button18_Click() Dim Row_Source As Range Dim WS As Worksheet, WS2 As Worksheet Dim Day_Num As String Dim Day_Dest As Range Dim PRL As String Dim Address As String Dim RowNum As Long Dim Cell As Range Set Cell = ActiveCell ' just in case you'll decide to give-up on the "bad practice" of using ActiveCell RowNum = Cell.Row Set WS = ThisWorkbook.Sheets("Protocols") Set WS2 = ThisWorkbook.Sheets("Formulas") With WS PRL = .Range("B" & RowNum).Value Day_Num = InputBox("Please enter a day number to add to: " & PRL, "Add New Day") If Day_Num <> "" Then Set Row_Source = .Rows(RowNum) Row_Source.Copy Row_Source.Offset(1).Insert Shift:=xlDown Application.CutCopyMode = False .Range("D" & RowNum + 1).Value = Day_Num End If End With With WS2 Set Row_Source = .Rows(RowNum) Row_Source.Copy Row_Source.Offset(1).Insert Shift:=xlDown Application.CutCopyMode = False End With End Sub 

Answer 2

这是它的代码。 如果没有Shai Rado，我不可能完成这个任务。 这完全符合规范：

 Sub Button18_Click() Dim Row_Source As Range Dim WS As Worksheet, WS2 As Worksheet Dim Day_Num As String Dim Day_Dest As Range Dim PRL As String Dim RowNum As Long Dim Cell As Range Set Cell = ActiveCell ' just in case you'll decide to give-up on the "bad practice" of using ActiveCell RowNum = Cell.Row Set WS = ThisWorkbook.Sheets("Protocols") Set WS2 = ThisWorkbook.Sheets("Formulas") With WS PRL = .Range("B" & RowNum).Value Day_Num = InputBox("Please enter a day number to add to: " & PRL, "Add New Day") If Day_Num <> "" Then Set Row_Source = .Rows(RowNum) End If End With With WS2 If Day_Num <> "" Then Set Row_Source = .Rows(RowNum) Row_Source.Offset(1).Insert Shift:=xlDown Application.CutCopyMode = False End If End With With WS If Day_Num <> "" Then Set Row_Source = .Rows(RowNum) Row_Source.Copy Row_Source.Offset(1).Insert Shift:=xlDown Application.CutCopyMode = False .Range("D" & RowNum + 1).Value = Day_Num End If End With With WS2 Set Row_Source = .Rows(RowNum) Row_Source.Copy Row_Source.Offset(1).PasteSpecial Application.CutCopyMode = False End With End Sub