D
DarnTootn
My problem is ... everthing opens and saves and closes. What happens is it
does not go to the next line when pasting to the worksheet. It only pastes
any further data to the same row ie. A2:AC2. So I need it to open the closed
workbook copy the source range A2:AC2, paste in the open worksheet to the
NEXT open row. Can someone help me with my code??
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A2"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Sub Copy_To_Another_Workbook()
Dim sourceRange As Range
Dim destRange As Range
Dim destWB As Workbook
Dim Lr As Long
Application.ScreenUpdating = False
If bIsBookOpen("Glenns Stats.xls") Then
Set destWB = Workbooks("Glenns Stats.xls")
Else
Set destWB = Workbooks.Open("F:\FILE_CAB\FIREFFTR\Crew
Statistics\Glenns Stats.xls")
End If
Lr = LastRow(destWB.Worksheets("STATS")) + 1
Set sourceRange = ThisWorkbook.Worksheets("STATS").Range("A2:AC2")
Set destRange = destWB.Worksheets("STATS").Range("A" & Lr)
sourceRange.Copy
destRange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End Sub
does not go to the next line when pasting to the worksheet. It only pastes
any further data to the same row ie. A2:AC2. So I need it to open the closed
workbook copy the source range A2:AC2, paste in the open worksheet to the
NEXT open row. Can someone help me with my code??
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A2"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Sub Copy_To_Another_Workbook()
Dim sourceRange As Range
Dim destRange As Range
Dim destWB As Workbook
Dim Lr As Long
Application.ScreenUpdating = False
If bIsBookOpen("Glenns Stats.xls") Then
Set destWB = Workbooks("Glenns Stats.xls")
Else
Set destWB = Workbooks.Open("F:\FILE_CAB\FIREFFTR\Crew
Statistics\Glenns Stats.xls")
End If
Lr = LastRow(destWB.Worksheets("STATS")) + 1
Set sourceRange = ThisWorkbook.Worksheets("STATS").Range("A2:AC2")
Set destRange = destWB.Worksheets("STATS").Range("A" & Lr)
sourceRange.Copy
destRange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End Sub