If Then in VBA, check cell, enter data to other cell
"Tom Ogilvy" wrote:
It tested you code:
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("test.xls") Then
' Set destWB = Workbooks("test.xls")
' Else
' Set destWB = Workbooks.Open("P:\COBdata\test.xls")
' End If
' Lr = LastRow(destWB.Worksheets("Sheet1")) + 1
' Set sourceRange = ThisWorkbook.Worksheets( _
' "COB_Cover_Sheet").Range("A1:C10")
With ThisWorkbook.Worksheets("Sheet1")
Set sourceRange = .Range("B19:V" & _
.Range("A" & Rows.Count).End(xlUp).Row)
End With
For Each cell In sourceRange.Columns(1).Cells
If cell.Value = 0 Then
Set sourceRange = sourceRange.Resize(cell.Row - 19)
Exit For
End If
Next
sourceRange.Select
Exit Sub
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End Sub
and it worked perfectly for me - especially for my contribution. If there
is a problem, it is probably that you don't have data extending down in
column A - but that was you code.
--
Regards,
Tom Ogilvy
"Win" wrote in message
...
Tom,
Thank you for the reply, I tried the code and it stops at the line marked
with **'s., Might you have any ideas
Thank You Again
Win
for each cell in sourceRange.columns(1).cells
if cell.Value = 0 then
***** set sourceRange = sourcerange.Resize(cell.row - 19) ******
exit for
end if
Next
Set destrange = destWB.Worksheets("Sheet1").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End Sub
|