problem with copy to another workbook

T

tanyhart

I have the following code posted below. It works the way that it is
supposed to however upon actually using it a few times I have noticed
one problem with it. It copies data from a selected row over to the
last line in another workbook, however when it copies over, it copies
the formatting of the previous row. The problem that I am running into
is that it copies data from the column I that I do not want it to. If
the cell says "COMPLETE" and new data is copied over, the formula that
I want in that cell is replaced with the word "COMPLETE". Is there a
way to correct this and just get the formula copied over. How it works
is that once the project is completed, the user manually enters COMPLETE
into the cell, but I don't want it copied when new projects are
entered.


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

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

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
destWB.Worksheets("Tracking Sheet").Cells(Lr, 9).FillDown
destWB.Worksheets("Tracking Sheet").Cells(Lr, 10).FillDown
Application.CutCopyMode = False
Application.ScreenUpdating = True
ThisWorkbook.Worksheets("Input Form").Range("G43").Value = "a"
ThisWorkbook.Worksheets("Input Form").Range("H43").Value = Now()
End Sub
 
K

Ken Johnson

Hi tanyhart,

Just a quick stab in the dark...

What if you change...

destrange.PasteSpecial xlPasteValues, , False, False

to...

destrange.PasteSpecial xlPasteFormulas, , False, False

Ken Johnson
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top