VBA - copying down a specific cell value ?

[Brendan89]

I need to add to the code below to also copy the value of cell 'Q3' down into each row each time the macro is enabled.
Sub New_Risk()
Dim varUserInput As Variant
varUserInput = InputBox("Enter Row Number where you want to add a row:", _
"What Row?")
If varUserInput = "" Then Exit Sub
RowNum = varUserInput
ActiveSheet.Unprotect "shearer"
With ActiveCell
Rows(RowNum & ":" & RowNum).Insert Shift:=xlDown
Rows(RowNum - 1 & ":" & RowNum - 1).Copy Range("A" & RowNum)
Range(RowNum & ":" & RowNum).SpecialCells(xlCellTypeConstants).ClearContents
End With
Application.CutCopyMode = False
ActiveSheet.Protect "shearer", AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
End Sub

Does anyone know if I need to add this to the 'Copy Range' part of this code or somewhere else?

Cheers!

 

[NARAYANK991]

Hi ,

I am not sure whether the code you have posted was doing its job or not ; see if this does what you want :

Sub New_Risk()
    Dim varUserInput As Variant
    varUserInput = InputBox("Enter Row Number where you want to add a row:", "What Row?")
    If varUserInput = "" Then Exit Sub


    RowNum = varUserInput
    ActiveSheet.Unprotect "shearer"
    With ActiveSheet
         .Rows(RowNum & ":" & RowNum).Insert Shift:=xlDown
         .Rows(RowNum - 1 & ":" & RowNum - 1).Copy .Range("A" & RowNum)
         .Range(RowNum & ":" & RowNum).SpecialCells(xlCellTypeConstants).ClearContents
         .Range("Q3").Copy .Range("Q" & RowNum)
    End With


    Application.CutCopyMode = False
    ActiveSheet.Protect "shearer", AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
End Sub

 

[JackDanIce]

Below copies Q3 to the inserted row, adjust to suit:

Sub New_Risk()
    
    Dim varUserInput As Variant
    
    varUserInput = InputBox("Enter Row Number where you want to add a row:", "What Row?")
    
    If Len(varUserInput) Then

        With ActiveSheet
            .Unprotect "shearer"
            .Cells(varUserInput, 1).Insert shift:=xlDown
            .Cells(varUserInput - 1, 1).EntireRow.Copy .Cells(rownum, 1)
            .Cells(varUserInput, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents
            .Cells(varUserInput, 17).Value = .Cells(3, 17).Value
            Application.CutCopyMode = False
            .Protect "shearer", AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
        End With
                
    End If

End Sub

 

[Brendan89]

Hi ,

I am not sure whether the code you have posted was doing its job or not ; see if this does what you want :

Sub New_Risk()
    Dim varUserInput As Variant
    varUserInput = InputBox("Enter Row Number where you want to add a row:", "What Row?")
    If varUserInput = "" Then Exit Sub


    RowNum = varUserInput
    ActiveSheet.Unprotect "shearer"
    With ActiveSheet
         .Rows(RowNum & ":" & RowNum).Insert Shift:=xlDown
         .Rows(RowNum - 1 & ":" & RowNum - 1).Copy .Range("A" & RowNum)
         .Range(RowNum & ":" & RowNum).SpecialCells(xlCellTypeConstants).ClearContents
         .Range("Q3").Copy .Range("Q" & RowNum)
    End With


    Application.CutCopyMode = False
    ActiveSheet.Protect "shearer", AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering:=True
End Sub

That's done it! Thank you!