Keep Reference Cell in New Sheet

Question

I am basically trying to get actions taken on one sheet to be mirrored on another sheet. Copy and paste A1 to B1 on Sheet1? Copy and paste A1 to B1 on Sheet2. The problem is, it always needs to be in reference to the active cell and I can't figure out how to save the address of the active cell in a usable format.

Here is the scenario I want to accomplish, in pretty plain English:

Where Cell is ActiveCell on Sheet1, insert row below Cell's row on Sheet2 (e.g., if Sheet1!A1 is active cell, insert row below Sheet2 row 1).
On Sheet1: Copy ActiveCell.Row and insert below ActiveCell.Row.
On Sheet2: Perform same, but on corresponding rows on Sheet2, except I want to paste it in my newly inserted row from Step 1. So, if I copied Sheet1 Row 1 and inserted it below Row 1 in Step 2, I want to copy Sheet2 Row 1 and PASTE it in the new row from Step 1.
Returning to Sheet1, use InputBox to get a value from the user, insert that value in Range("D" & (ActiveCell.Row))

I have this all working, except the Sheet2 part, and it breaks formulas if I can't get that line in before I copy/insert on Sheet1. I have gone through the steps manually and it all works if I can get it coded.

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

End Sub

Trevor · Accepted Answer

This is the code that did it. I couldn't have completed this without Shai Rado, where most of the credit should go. This works exactly to specification:

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

Keep Reference Cell in New Sheet

Answers (2)

Related Questions