PDA

View Full Version : [SOLVED] Copy a block of lines/rows and paste to another worksheet



Ted608
03-30-2015, 07:49 PM
Hi

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



I would like to transfer a block of lines/rows from 1 worksheet and paste it to another worksheet.
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
03-31-2015, 03:22 AM
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
03-31-2015, 06:48 AM
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
03-31-2015, 07:30 AM
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
03-31-2015, 10:14 AM
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
04-01-2015, 01:02 AM
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
04-01-2015, 01:47 AM
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
04-01-2015, 02:31 AM
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
04-01-2015, 07:49 AM
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
04-01-2015, 12:32 PM
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
04-01-2015, 02:37 PM
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
04-01-2015, 06:34 PM
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
04-01-2015, 07:06 PM
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
04-02-2015, 01:45 AM
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
04-02-2015, 01:51 AM
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
04-02-2015, 04:09 AM
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
04-02-2015, 04:17 AM
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
04-02-2015, 04:36 AM
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
04-02-2015, 05:33 AM
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
04-02-2015, 06:28 AM
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

Ted608
04-02-2015, 11:06 AM
Hi Yongle

I thought that I had it working but when I took a look closely at the pasted data it actually got pasted on top of the previous data.

To simplify troubleshooting, I stripped off all the bells and whistles and went back to your 2 originals: CopyRows_Until_2BlankRows() and CopyRows_Until_2BlankRowsB() and re-tested them thoroughly onto a blank sheet2 and this is what I got:



The 1st time I ran the code the data got pasted on line 2 down.
Each subsequent ran of the code the data got pasted on top of prior data there but offsetting 1 line down.


For example:



[*=1]The 2nd run of the code the pasting starting from line 2
[*=1]The 3rd run of the code the pasting starting from line 3 ....


..... and writing on top of the existing data.


3. There is no difference in results from the 2 original versions.

[Note: I don't know if this is related or not. Each block of my data consists of 3 lines, 18 columns or precisely ===> 2 consecutive lines with data on them and 1 blank line to separe them.]

Would you mind taking a 2nd close look at the codes why are they behaving the way they are and how would they be fixed?

Again, much appreciation for your time and energy in helping me out.
Ted

Ted608
04-02-2015, 12:13 PM
Updated:

Hi Yongle,

I think I know what the problem was:

It is the inconsistencies of the data in the column A. Sometimes there are data in it other time there is none. So what I did was finding a column with consistent data in it so that I can use it for the ... Range("CC").End(xlUp).offset(1,0).Row ... and so far it is working!

Yongle
04-02-2015, 10:32 PM
For the pasting to start either at A12 or the next available row down, a cleaner option would be an IF statement:


If Worksheets("Sheet2").Range("A12") = "" Then
NextRow = 12
Else
NextRow = Worksheets("Sheet2").Range("A11").End(xlDown).Offset(1, 0).Row
End If

This checks to see
if A12 is empty,
then next row is 12
but if A12 is not empty
then go to the last occupied cell in column A and down one more row

Yongle
04-02-2015, 11:06 PM
And finally..
Your problems started because of moving an unknown number of rows from one place to another, and squeezing it in above other data
Here is a much easier solution, which most people never think about.
It uses the camera facility in Excel and is as simple as taking a picture...

Firstly - add the Camera icon to your toolbar

13114

Now go back to your data
Next - highlight the data area and click on the Camera icon
Next - click where you want the "picture" to be placed (even a different sheet)
Next - change the value of the data
Amazingly the "picture" is live and the values change there too

13115

So your Sheet2 could be a gallery of "live" pictures

Ted608
04-03-2015, 11:04 AM
Hi Yongle

Thanks for the IF statement suggestion & the camera!

For the camera, it is very interesting & nice to know! I am sure this functionality will be of very handy or even a necessity for me when the time comes.

For the IF statement, I am trying to clean up & tidying all my works to see if I can incorporate it anywhere to make the codes run more efficient.

Happy Easter Yongle!