Copy a block of lines/rows and paste to another worksheet

[Ted608]

Hi

I am new to Excel and I need some help in writing the code for the following problem:

1. I would like to transfer a block of lines/rows from 1 worksheet and paste it to another worksheet.
2. The Range of interested: "A200:A297". Stop copying when it reaches the 1st of two consecutive empty lines/rows.

Thank you for taking the time to read through this and much appreciated for any help.

 

[sijpie]

something like:

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> copyBlock()<br>    <SPAN style="color:#00007F">Dim</SPAN> wsOut <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> rOut <SPAN style="color:#00007F">As</SPAN> Range, rIn <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> vArr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> lR <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#007F00">' copy column A into an array for quick checking for double empty</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rIn = Range("A200:A297")<br>    vArr = rIn.Value<br>    <SPAN style="color:#00007F">For</SPAN> lR = 1 <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(vA, 1) - 1<br>        <SPAN style="color:#007F00">' find double empty row</SPAN><br>        <SPAN style="color:#00007F">If</SPAN> vA(lR, 1) = vbEmpty And vA(lR + 1, 1) = vbEmpty <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> lR<br>    <br>    <SPAN style="color:#007F00">' set input range</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rIn = rIn(1, 1).Resize(lR, 1).EntireRow<br>    <br>    <SPAN style="color:#007F00">'copy the lines accross</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsOut = Sheets("Output") <SPAN style="color:#007F00">'<<<< You need to set the correct sheet name here!!</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rOut = wsOut.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) <SPAN style="color:#007F00">' set output to 1st empty row</SPAN><br>    <br>    rOut.Resize(lR, 1).EntireRow.Value = rIn.Value<br>    <br>    <SPAN style="color:#007F00">' cleanup</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rIn = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rOut = <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> wsOut = <SPAN style="color:#00007F">Nothing</SPAN><br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>



Note: you will have to adjust the name of the output sheet in the code

 

[Ted608]

Thank you very much, Sijpie for taking the time to write and comment the codes. It works beautifully!
Ted