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.

[Yongle]

I would like to transfer a block of lines/rows from 1 worksheet and paste it to another worksheet.

Sub CopyRows()'copies rows 200 to 297 from sheet1 to next available rows in sheet2 (does not look for any empty rows)
    Dim NextRow As Long
    Worksheets("Sheet1").Rows("200:297").EntireRow.Copy
    NextRow = Worksheets("Sheet2").Range("A1048576").End(xlUp).Offset(1, 0).Row
    Worksheets("Sheet2").Range("A" & NextRow).PasteSpecial xlPasteAll
End Sub

The Range of interested: "A200:A297". Stop copying when it reaches the 1st of two consecutive empty lines/rows.

Sub CopyRows_Until_2BlankRows()
'searches sheet1 row 200 to 297 for next 2 consecutive blank rows
'copies from row 200 to row before first consecutive 2 blank rows
'if 2 blank rows not found, entire range is copied
    Dim NextRow As Long
    Dim i As Integer
    Dim j As Integer
With Worksheets("Sheet1")
    For i = 200 To 298
        If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
            If Application.WorksheetFunction.CountA(Rows(i + 1)) = 0 Then
                j = i - 1
                i = 298
            End If
        End If
    Next i
    Worksheets("Sheet1").Rows("200:" & j).EntireRow.Copy
    NextRow = Worksheets("Sheet2").Range("A1048576").End(xlUp).Offset(1, 0).Row
    Worksheets("Sheet2").Range("A" & NextRow).PasteSpecial xlPasteAll
End With
End Sub

[Ted608]

Hi Yongle

Very much appreciation for your quick help! The code work perfectly.
However, how would I change the code so that it does not paste directly on top of other "contents" that I have in the destination "sheet2"?

Thanks again Yongle.

[Yongle]

Have you tried running it more than once, it should already do that
Let me explain quickly what the code is doing

at the top
Dim NextRow As Long - declares the variable NextRow 

copy the original data
Worksheets("Sheet1").Rows("200:" & j).EntireRow.Copy

go to cell A1048576 (bottom of sheet)
find last cell in column A with anything in it  code is the end(xlUP)
go to next row using  Offset(1, 0) 
and that row = NextRow
NextRow = Worksheets("Sheet2").Range("A1048576").End(xlUp).Offset(1, 0).Row

Paste the original data to column A with row = NextRow Range("A" & NextRow).PasteSpecial
Worksheets("Sheet2").Range("A" & NextRow).PasteSpecial xlPasteAll

[Ted608]

Hi Yongle

Thanks again for your quick reply and for taking the extra time to explain to me how the code works.

1. I did run the code many times but I need to fix it a little bit to make it paste --> starting from row 12 down. So I fixed the code as follow:


NextRow = Worksheets("sheet2").Range("A1048576").End(xlUp).offset(11, 0).Row


Sheets("sheet2").Select 'destination
rows("12:14").Select 'My block of data is 2 non-empty rows + 1 empty row
Selection.Insert Shift:=x1Down, CopyOrigin:=x1FormatFromLeftOrAbove

The above code seems to work except that it does not leave a blank line between the old data on sheet2 (starting row = 12) and the newly copied data. (and I am still trying to fix this)

2. I also need to clear the contents of sheet1 (A200:A297) so what I did was to copy a blank block of lines from an empty sheet and paste them on top of sheet1 (A200:A297).

Sheets("Templates").Select ' clear contents of A200:A297
Range("A200:A297").Select ' Copy empty rows
Selection.Copy
Sheets("sheet1").Select
Range("A200:R297").Select ' Overwrite with empty lines
ActiveSheet.Paste

The above code seems to work for what I need at the moment and I am sure you may have a much better more efficient solution which I would not mind to try.

[Ted608]

Hi Yongle

I need to solve another problem:

I would like to delete a "j" number of rows in order to keep this "destination" lenth of range = constant.

I am thinking of deleting some rows from the bottom of the range of sheet2 upward where there is no data (because most of the time the copied block length is < 100) and at present I allow it almost 3x of what it might need. (A12:A297).

Currently the above code did work as expected except that it shifts the row down & corrupt my other data from row (400:1000).

I've been trying:

rows("397-j :398).Delete

but I got the run-time error 13: type mismatch. What is the correct syntax for subtracting j numbers of rows ... or is there no such syntax?

Thanks again for all your time & help.
Ted

[Yongle]

Try this small variation of the original code - just paste the whole lot in - and run it.
You said you wanted the paste to to start at Row 12
Put anything in cell A11 (and nothing below that) and the code will automatically do what you want, because it always looks for the last entry in column A and pastes to the next row down
It will then paste every time to the next empty row down every time it runs (so no need for the offset(11,0) that you added etc

Sub CopyRows_Until_2BlankRowsB()
'searches sheet1 row 200 to 297 for next 2 consecutive blank rows
'copies from row 200 to row before first consecutive 2 blank rows

    Dim NextRow As Long
    Dim i As Integer
    Dim j As Integer
With Worksheets("Sheet1")

    For i = 200 To 298
        j = 297
        If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
            If Application.WorksheetFunction.CountA(Rows(i + 1)) = 0 Then
                j = i - 1
                i = 298
            End If
        End If
        Next i
End With
    Worksheets("Sheet1").Rows("200:" & j).EntireRow.Copy
    NextRow = Worksheets("Sheet2").Range("A1048576").End(xlUp).Offset(1, 0).Row
    Worksheets("Sheet2").Range("A" & NextRow).PasteSpecial xlPasteAll
    Worksheets("Sheet1").Rows("200:" & j).EntireRow.Delete

End Sub

Explanation
I added this line - just in case there is something below line 297 (it could be causing the mismatch issue)

j = 297

This line deletes what was copied to sheet2

Worksheets("Sheet1").Rows("200:" & j).EntireRow.Delete

But if you really want to delete from 200 to 297 then replace the above line with:

Worksheets("Sheet1").Rows("200:297").EntireRow.Delete

[Ted608]

Hi Yongle
Thanks again for your quick reply.

What you just gave me delete what was copied FROM sheet1 but I need some help on how to delete the the extra lines in the DESTINATION = sheet2 because in this sheet2 after being copied, the row number has been shifted and I have other data from row(400: 1000) and I don't want to corrupt the data from those rows.

Thanks Yongle.
Ted

[Yongle]

If you always want the pasting to occur above row400, amend the line of code beginning with NextRow and make the range instruction Range("A399") .
This sends the vba to A399 and then up until it finds the last cell with data in column A, the offset sends it down 1 row

NextRow = Worksheets("Sheet2").Range("A399").End(xlUp).Offset(1, 0).Row

[Ted608]

Hi Yongle

Very much appreciation for your help!

The very first code that you wrote (post #2) works perfectly except that I am still have not figured out way to keep my destination = "sheet2" row number remain intact - from row(400:1000) because I have a summation formula keeping track of my data from rows(400:1000).

After each special pasting from "sheet1" (the source) to "sheet2" the destination - the row number keeps increasing ie. row 400 became 432 ... and so on depending on the 'row' length of the source.

I just want the destination sheet2 row number remains as follow:

.
.
Row 12 to ..)
................ )
................ )
................ )
Row 399 ....) =====> Reserved for pasting data from sheet1 - do not write on top of other data currently on here; starting from row(12) and continue to shift the data down the line and out when it reaches row(399)





Row 400 )
.............. )
.............. ) =====> My other data (Row # must remain constant)
.............. )
Row 1000 )


[How do I instruct it to delete the exact x number of rows that it has just copied to this destination "sheet2" so that the row(400:1000) still remain unchanged?]

[Yongle]

Can you post the whole of the macro you are now using (with code tags).
I would not expect it to be inserting rows - should be able to stop it inserting and then we do not need to delete.
thanks

[Ted608]

Hi Yongle,

Thanks again for your time & effort in helping me out.

Below are the codes that I tried to patch & paste to the best of my ability at the moment.

For now, everything seems to work ok except that the block of row(400:1000) in sheet2 got shifted down as I pasted the data from sheet1 into sheet2 hence messing up my summing formula for this particular block of row(400:1000).

Sub CopyRows_Until_2BlankRows()
'CopyRows_Until_2BlankRows
'searches sheet1 row 200 to 297 for next 2 consecutive blank rows
'copies from row 200 to row before first consecutive 2 blank rows
'if 2 blank rows not found, entire range is copied

Dim NextRow As Long
Dim i As Integer
Dim j As Integer

With Worksheets("Sheet1")

For i = 200 To 298

If Application.WorksheetFunction.CountA(rows(i)) = 0 Then

If Application.WorksheetFunction.CountA(rows(i + 1)) = 0 Then

j = i - 1

i = 298

End If

End If

Next i
Worksheets("Sheet1").rows("200:" & j).EntireRow.Copy
NextRow = Worksheets("Sheet2").Range("A398").End(xlUp).offset(11, 0).Row 'paste to Sheet2 offset 11 lines

Sheets("Sheet2”).Select ' Destination
rows("12:14").Select 'start pasting at line 12
Selection.Insert Shift:=x1Down, CopyOrigin:=x1FormatFromLeftOrAbove 'I think this is the line that cause the problem! I just found out now!

Worksheets("Sheet2").Range("A" & NextRow).PasteSpecial xlPasteAll 'do until done

End With

Sheets("Sheet1").Select
Range("A200:R297").Clear 'Clear Contents of the source

End Sub

[Ted608]

Bingo Yongle!

Thank you! Thank you! Thank you! Yongle.

Also I just found out that it is pasting from the bottom up. How would I change the code so that it will paste from line 12 down rather than from wherever there is empty space of this row block(12:399) from the bottom up?

[Yongle]

the syntax is to start the pasting from the next empty cell after A12 is :

Range("A10").End(xlDown).Offset(1, 0).Row

Cell A11 MUST contain a value



You have solved your mystery insert puzzle, and so you no longer need this answer, but to delete an equivalent number of rows to what you had inserted you would need something like:

Sub deleterows()
   
    j = number of rows to be deleted
    k = 400 - j      ' = First row to be deleted
    ActiveSheet.Rows(k & ":399").EntireRow.Delete
End Sub

which would delete the correct number of rows immediately above row400

[Yongle]

A little bonus : VBA tip for today!

You do not need to select in VBA
so instead of :

Sheets("Sheet1").Select 
Range("A200:R297").Clear 'Clear Contents of the source

use:

Sheets("Sheet1").Range("A200:R297").Clear 'Clear Contents of the source

[Ted608]

Hi Yongle

Thanks again for your much needed help!

Cell A11 MUST contain a value

Is there a command that I can use WITHOUT requiring Cell A11 contain a value. I have some data at Range(U2:Z10) but not at A11.

[Ted608]

Sub deleterows()
j = number of rows to be deleted
k = 400 - j ' = First row to be deleted
ActiveSheet.Rows(k & ":399").EntireRow.Delete End Sub

Thanks Yongle! for this answer because these lines of code I am sure will be of great important to me as I have not be able to do it until now.

Programming is new to me especially VBA. I just started learning it about 2 weeks ago to help me stream line my work.

Thank you very much for being so patient to such a newbie!

[Yongle]

Is there a command that I can use WITHOUT requiring Cell A11 contain a value. I have some data at Range(U2:Z10) but not at A11.

Use A10's value instead and change the offset as follows:

Worksheets("Sheet2").Range("A09").End(xlDown).Offset(2, 0).....etc...

Can you now please go to top of thread and click on thread tools and mark the thread as "SOLVED"
thanks

These words from the Forum FAQ explain why we ask for this to be done
How do I mark a thread as Solved, and why should I?

If your problem has been solved in your thread, mark the thread "Solved" by going to the "Thread Tools" dropdown at the top of the thread. You might also consider rating the thread by going to the "Rate Thread" dropdown which is next to the "Thread Tools" dropdown.

This lets future site visitors with the same problem know that the thread contains a solution. It also rewards the volunteer(s) who helped you solve your problem. Remember that the forum is filled with unpaid volunteers helping you with your problem -- marking your thread as solved and/or rating it is the payment for their help.

[Ted608]

Hi yongle

Sorry to bother you again.

Regarding

NextRow = Worksheets("sheet2").Range("A09").End(xlDown).offset(3, 0).Row 'pasting from line A9 + offset 3 = 12

After entering this line of codes it starts pasting from row(12) but I think it is writing on top of what I am having there.

Is it possible that I can have it starts pasting from row(12) and shifts whatever data I have from row(13) down the line and out of the block when it reaches row(399) ?

[Yongle]

You can keep adding the end down and offset to get to where you want. So this will take you to where you want....

....Range("A9").End(xlDown).Offset(3, 0).End(xlDown).Offset(1, 0)... etc