Copy over formula to specific cell

[tanyhart]

The code that I have from Ron de Bruin to copy data from one workbook to
another, and it works well. However I have one column (Col I) that I
need the actual formula copied over. As it stands now, it works out
the calculation and places the result in the cell, what I want is the
copy command to paste the actual formula. This way the user can change
something in the destination workbook and still have to formula to
recalculate a result.

I know I could add a line like

Code:
--------------------

destrange.PasteSpecial xlPasteFormulas, , False, False

--------------------


but this copies over all formulas when I only want one specific one.

Here is the copy and paste code


Code:
--------------------

Sub sendtotracking()
Dim smallrng As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long

Application.ScreenUpdating = False
If bIsBookOpen("P&WM Estimate Tracking Sheet.xls") Then
Set destWB = Workbooks("P&WM Estimate Tracking Sheet.xls")
Else
Set destWB = Workbooks.Open("O:\PWM_Shared_Files\Stations Estimates\Estimate Tracking Sheet\P&WM Estimate Tracking Sheet.xls")
End If
Lr = LastRow(destWB.Worksheets("Tracking Sheet")) + 1
Set SourceRange = ThisWorkbook.Worksheets("Links").Range("A1:X1")
Set destrange = destWB.Worksheets("Tracking Sheet").Range("A" & Lr)
SourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Input Form").Range("G43").Value = "a"
ThisWorkbook.Worksheets("Input Form").Range("H43").Value = Now()
End Sub

 

[Die_Another_Day]

This is the easiest way I can think of:
Sub sendtotracking()
Dim smallrng As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long


Application.ScreenUpdating = False
If bIsBookOpen("P&WM Estimate Tracking Sheet.xls") Then
Set destWB = Workbooks("P&WM Estimate Tracking Sheet.xls")
Else
Set destWB = Workbooks.Open("O:\PWM_Shared_Files\Stations
Estimates\Estimate Tracking Sheet\P&WM Estimate Tracking Sheet.xls")
End If
Lr = LastRow(destWB.Worksheets("Tracking Sheet")) + 1
Set SourceRange = ThisWorkbook.Worksheets("Links").Range("A1:X1")
Set destrange = destWB.Worksheets("Tracking Sheet").Range("A" & Lr)
SourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Set SourceRange = ThisWorkbook.Worksheets("Links").Range("I1")
Set destrange = destWB.Worksheets("Tracking Sheet").Range("I" & Lr)
SourceRange.Copy
destrange.PasteSpecial xlPasteFormulas, , False, False
Application.CutCopyMode = False
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Input Form").Range("G43").Value = "a"
ThisWorkbook.Worksheets("Input Form").Range("H43").Value = Now()
End Sub

Basically after you copy everything you go back and overwrite Column
"I" with the formula

HTH

Die_Another_Day

 

[tanyhart]

Works like a charm, Thanks.