Private Sub : copy formula

[satish gubbi]

I need the below private sub code to work, when I place the data in the work sheet.

kindly help.

[VBA]
Private Sub ActAdj(ByVal Target As Range)
Dim lastrow
With ActiveSheet
lastrow = .Range("B4").End(xlDown).Row
With .Range("E4").Resize(lastrow - 6) 'E4 here would from where the formula needs to be copied

ActiveSheet.Range("E2").Copy .Cells
.Value = .Value
End With
End With
End Sub
[/VBA]

This Code should automatically pick the formula, as soon as I place value in cell D4 onwards.

Kindly help

[patel]

Don't propose a code, explain better your goal.
which formula do you want copy ? what's the result after macro run ?

[satish gubbi]

I need a Private Sub Code which copies formula from given cell reference and copies values only when I place a specific word (in this case "Completed")

If i enter "completed" in A3, in B3 formula should be copied from B2 and paste only values.

kindly help

[Teeroy]

I can't see why you need the private sub. Run this code from a standard module to set the values for everything existing on the sheet. There was a discrepancy between the cell addresses in the example you gave in your posts and the workbook so I've gone with the workbook addresses.

[vba]Sub ActAdj()
Dim lastrow
Dim rng As Range
With ActiveSheet
lastrow = .Range("B4").End(xlDown).Row
With .Range("E4").Resize(lastrow - 3) 'E4 here would from where the formula needs to be copied
ActiveSheet.Range("E2").Copy
.Cells.PasteSpecial Paste:=xlPasteFormulas
.Value = .Value
End With
Application.CutCopyMode = False
End With
End Sub[/vba]

Put the following code in the sheet1 code container to handle future changes.

[vba]Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Columns("D")) Is Nothing Then
ActiveSheet.Range("E2").Copy
With Target.Offset(0, 1)
.PasteSpecial Paste:=xlPasteFormulas
.Value = .Value
End With
Application.CutCopyMode = False
End If
End Sub[/vba]