Copy to new worksheet problem

T

tanyhart

I have the following code. It works wonderfully, although upon actually
using the macro a few times I've noticed one error. I have it copying
the formatting of the previous row (I think) and there is one column
that I do not want the value copied from (row I). The range that I
want copied over contains the formula that I want in that cell, however
when I copy it over, if the cell above where the new data is pasted says
"COMPLETE", it overwrites the formula and enters COMPLETE in the cell.
How would I correct this?


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
 

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