ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Copy to new worksheet problem (https://www.excelbanter.com/excel-programming/367938-copy-new-worksheet-problem.html)

tanyhart[_34_]

Copy to new worksheet problem
 

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


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


Thanks


--
tanyhart
------------------------------------------------------------------------
tanyhart's Profile: http://www.excelforum.com/member.php...o&userid=35148
View this thread: http://www.excelforum.com/showthread...hreadid=563662



All times are GMT +1. The time now is 11:08 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com