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 wrote:
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
--------------------
Thanks
--
tanyhart
------------------------------------------------------------------------
tanyhart's Profile: http://www.excelforum.com/member.php...o&userid=35148
View this thread: http://www.excelforum.com/showthread...hreadid=565123