Need exit Sub modification
 

Thanks in advance for your continued help.

The code below currently exits/End Sub when the Row in
column N is blank. Since it is possible for row N# to be
blank I need the code to exit only when both column M and
N are blank on the same row. Otherwise, the code works
fine. Thanks again. Dan

Sub mcrCopyToFinal()
Worksheets("ScrubData").Activate
Dim Rng As Range
Dim i As Integer
Dim Dest As Range
Set Rng = Sheets("ScrubData").Range("N2")
If Sheets("Final").Range("A1") = "" Then
Set Dest = Sheets("Final").Range("A2")
Else
Set Dest = Sheets("Final").Range("A65536").End(xlUp)
End If
While Rng < ""
While Rng.Offset(0, i) < ""
Rng.Offset(0, i).copy Dest
Range(Rng.Offset(0, -13), Rng.Offset(0, -1)).copy
Dest.Offset(0, 1)
Set Dest = Dest.Offset(1, 0)
i = i + 1
Wend
Set Rng = Rng.Offset(1, 0)
i = 0
Wend

Set Rng = Nothing

End Sub

Need exit Sub modification
 

Is this what you want

While Rng.Offset(0, i) < "" ANd Rng.Offset(0, i + 1) < ""

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Dan" wrote in message
...
Thanks in advance for your continued help.

The code below currently exits/End Sub when the Row in
column N is blank. Since it is possible for row N# to be
blank I need the code to exit only when both column M and
N are blank on the same row. Otherwise, the code works
fine. Thanks again. Dan

Sub mcrCopyToFinal()
Worksheets("ScrubData").Activate
Dim Rng As Range
Dim i As Integer
Dim Dest As Range
Set Rng = Sheets("ScrubData").Range("N2")
If Sheets("Final").Range("A1") = "" Then
Set Dest = Sheets("Final").Range("A2")
Else
Set Dest = Sheets("Final").Range("A65536").End(xlUp)
End If
While Rng < ""
While Rng.Offset(0, i) < ""
Rng.Offset(0, i).copy Dest
Range(Rng.Offset(0, -13), Rng.Offset(0, -1)).copy
Dest.Offset(0, 1)
Set Dest = Dest.Offset(1, 0)
i = i + 1
Wend
Set Rng = Rng.Offset(1, 0)
i = 0
Wend

Set Rng = Nothing

End Sub