VBA Code Fix: Appending All Rows to New Sheet, but One Row of Each is Missing

[bklmabry]

I was so proud when I modified the VBA code from JLGWhiz' reply to "VBA: Copy all rows with data from one sheet and paste on bottom of another" from this forum in order to copy/paste the rows from ten sheets, and it looked at first glance like it worked!

On closer inspection, I found that the final list of rows contained one less row per worksheet it copied from; i.e. worksheet 1 contains 13 rows but only 12 were copied. I'm sure there's something that needs to be tweaked in the code, but I'm only just learning VBA and can't quite root it out.

The original code from the earlier forum was:

Sub cpynpst()
Dim sh4 As Worksheet, sh5 As Worksheet, lr As long, rng As Range
Set sh4 = Sheets("Sheet4")
Set sh5 = Sheets("Sheet5")
lr= sh4.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh4.Range("A2:A" & lr)
rng.EntireRow.Copy sh5.Cells(Rows.Count, 1).End(xlUp)(2)
End Sub

It's not the most elegant, I'm sure, but I modified it thus:

Sub cpynpst()

Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet, sh5 As Worksheet
Dim sh6 As Worksheet, sh7 As Worksheet, sh8 As Worksheet, sh9 As Worksheet, sh10 As Worksheet
Dim sh0 As Worksheet, lr As Long, rng As Range

Set sh1 = Sheets("1")
Set sh2 = Sheets("2")
Set sh3 = Sheets("3")
Set sh4 = Sheets("4")
Set sh5 = Sheets("5")
Set sh6 = Sheets("6")
Set sh7 = Sheets("7")
Set sh8 = Sheets("8")
Set sh9 = Sheets("9")
Set sh10 = Sheets("10")
Set sh0 = Sheets("Sum")

lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh1.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

lr = sh3.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh3.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

lr = sh4.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh4.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

lr = sh5.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh5.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

lr = sh6.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh6.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

lr = sh7.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh7.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

lr = sh8.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh8.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

lr = sh9.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh9.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

lr = sh10.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh10.Range("A2:A" & lr)
rng.EntireRow.Copy sh0.Cells(Rows.Count, 1).End(xlUp)(2)

End Sub



I'm almost certain that something in those last paragraphs is causing the module to copy one less row per worksheet or copy over prior rows in each worksheet. Can someone, maybe JLGWhiz, offer some help?

Thank you!

 

[JackDanIce]

Sheets("Sum") I think!

 

[bklmabry]

I can't tell without your spreadsheet or code you're using, what line was the actual error on?

Here was the line of the error (from selecting "debug":

https://www.dropbox.com/s/50cqz6ubkm2ugwv/Error03.PNG?dl=0

And here was the error dialog box itself:

https://www.dropbox.com/s/jnma5vn2o55taiz/Error.PNG?dl=0

Thanks so much!

 

[bklmabry]

JackDanIce! It worked! The code with the worksheets listed actually worked! It's just the the module aborted because one of the sheets had no data to append to the final list! I'm going to try the other code as well because in that one, it looks like it doesn't require the itemized worksheet names. Thanks so much! I'll report back after I've tried it.

Thanks,

 

[JackDanIce]

Glad you resolved it, I just tried a dummy version of your file and it worked fine for me so couldn't tell what was going wrong.

 

[bklmabry]

For the second solution, the error was as follows:

https://www.dropbox.com/s/dj4bz3vmwuig5ro/Error05.PNG?dl=0
https://www.dropbox.com/s/l49ps7t72r6h64b/Error06.PNG?dl=0

Thanks so much!

 

[JackDanIce]

You're welcome

 

[JLGWhiz]

For the second solution, the error was as follows:

https://www.dropbox.com/s/dj4bz3vmwuig5ro/Error05.PNG?dl=0
https://www.dropbox.com/s/l49ps7t72r6h64b/Error06.PNG?dl=0

Thanks so much!

Worksheets(Sum) should be Worksheets("Sum"). My error.
Regards, JLG

If you have a blank sheet you will get an Object Variable not set message. Range A1 will need something in it.