transfer if there are no blank cells

[ahmed haleem]

Transferring data from one sheet(1) to sheet(2) if there are no blank cells
Sub transfer()

mr1 = Sheets(1).Range("a" & Rows.Count).End(xlUp).Row
For i = 3 To mr1
For j = 1 To 5
If Sheets(1).Cells(i, j).Value = "" Then
Sheets(1).Cells(i, j).Interior.ColorIndex = 4
'MsgBox "there are no blank cells"
End If
Next
Next
MsgBox "there are no blank cells"
Sheets(1).Range("A3:E" & Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1).Interior.ColorIndex = 2
Application.CutCopyMode = False

Sheets(1).Activate

lr1 = [a1000].End(xlUp).Row
Range("a3:e" & lr1).Copy
Sheets(2).Activate
lr2 = Range("a" & Rows.Count).End(xlUp).Row
Range("a" & lr2 + 1).Select
Selection.PasteSpecial xlPasteValues
Sheets(1).Activate

Application.CutCopyMode = True

End Sub26975