Solved: Check my code please to find next blank row
The code below works to a point ,it copies and pastes data from 3 work sheets to another 3 work shirts.My problem is that it pastes the new data over the exsisting data, at the top of the target sheet.I need it to find the next empty row at the bottom of the target sheets and than paste the data.I think the problem maybe the code which I have highlighted but not sure.
THANKS
[VBA] Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", vbYesNo) = vbYes Then
Cancel = True
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim rngCopy As Range
Application.ScreenUpdating = False
Set SourceWb = Workbooks("HAS.xls")
Workbooks.Open filename:= _
"C:\Documents and Settings\Reception\My Documents\HAS2.xls"
Set TargetWb = Workbooks("HAS2.xls")
Rem remove >>>For Each SourceSheet In SourceWb.Sheets
Set SourceSheet = ActiveSheet: Rem New line <<<<
If SourceSheet.Name Like "*" Then 'Additional check here
For Each TargetSheet In TargetWb.Worksheets
If SourceSheet.Name = TargetSheet.Name Then
With TargetSheet.Range("A" & NextEmptyRow(TargetSheet))
.Offset(, 1).Resize(28).Value = SourceSheet.Range("C8:c35").Value
.Offset(, 2).Resize(28, 27).Value = SourceSheet.Range("E8:AE35").Value
End With
End If
Next TargetSheet
End If
Rem remove >>>Next SourceSheet
Application.Run "'HAS2.xls'!DeleteDups"
ActiveWorkbook.Save
ActiveWindow.Close
Application.ScreenUpdating = True
End If
End Sub
Function NextEmptyRow(oneSheet As Worksheet) As Long
With oneSheet
NextEmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
End Function[/VBA]
