Copying and pasting data between workbooks in an array of sheets

Question

I am lost and have tried to find this specific issue on multiple forums and cannot seem to piece it together. Very quick question hopefully. This code is meant to:

Search for last cell that contains data in 5 worksheets. It should search other than Column 'A' or 'B' for data, as these may or may not be blank.
repeat for all 5 sheets in array
Paste all data from 5 sheets in source workbook on 'Sheet 4' one after another

The problem I have is that maybe usedrange.copy is copying all data from the 5 workbooks strangely. It does not seem to copy ALL of the data (maybe counting column A to find last used row and copying based on that?).

Is there a different way of achieving what I am needing to do? I thought it would be easier because it is just copying all data from the 5 sheets and pasting in a different wkbk... but... nay. Any help is greatly appreciated.

    Sub Notes2()
'Last row in column
Dim WS As Worksheet, shAry As Variant, i As Long
Dim AOFF As Range
Dim rOWIS As Integer
Dim wb As Workbook, wb2 As Workbook
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
Set WS = Worksheets("Sheet 4")
With WS
    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    LastCellRowNumber = LastCell.Row + 1
End With
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(vFile)
With wb2
    shAry = Array(.Sheets("Week 1"), .Sheets("Week 2"), .Sheets("Week 3"), .Sheets("Week 4"), .Sheets("Over 30"))
End With
    For i = LBound(shAry) To UBound(shAry)
        shAry(i).UsedRange.Copy
        wb.Activate
        WS.Cells(Rows.Count, 3).End(xlUp).End(xlUp)(2).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    Next
Application.ScreenUpdating = True
'Close
wb2.Close False
End Sub

Do you really want to use `.End(xlUp)` twice in a row? Doing this is overwriting one or more rows of data in the WS sheet. Try this instead: `WS.Cells(Rows.Count, 3).End(xlUp)(2).PasteSpecial xlPasteValues` to paste the data starting at the first blank row at the end of the sheet. — Rachel Hettinger, May 07 '18 at 20:26
I did not mean to have that twice in a row like that. My error. Even after correcting that though, it seems the issue persists for some reason. Here is the excel wkbk to copy from: ufile.io/fkz2z and the source wkbk: ufile.io/6r9yf. I just added a blue button with the corrected code included. If you engage that macro you can see what is happening. It just does not want to seem to copy and paste orderly and mixes them up — Darkcloud617, May 07 '18 at 22:01
The better way to find where to paste data is to do this: `WS.Cells(WS.Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 3).PasteSpecial xlPasteValues`. This will paste data starting on the first unused row, column C. (p.s. while it's great you took the time to mock up data, I am uncomfortable downloading a file from an unknown source. Update your question to reflect code changes, and perhaps include a screenshot of data. Also, if problems persist, reduce your data to the smallest amount possible in order to see exactly what is going on. — Rachel Hettinger, May 07 '18 at 23:53
That worked perfectly. Kind of. It fixed the very odd pasting issue and it is aligned. But, the inherent part of the spreadsheet I am using this code on needs certain formulas in columns P-T. They are just formulas that are figuring other (unrelated) data. It looks like this is pasting below those columns where the formulas end (Row 1000 is where it stops). Do you know any quick way to modify that paste code to skip reading those columns and paste in A - O to the left, where it is the first blank row? — Darkcloud617, May 08 '18 at 19:37
From [stackoverflow.com/questions/37077059...](https://stackoverflow.com/questions/37077059/vba-find-last-row-of-a-specific-range-of-columns) try: `Set LastCell = WS.Range("C:O").Find(What:="*", SearchDirection:=xlPrevious)` and `WS.Cells(LastCell.Row + 1, 3).PasteSpecial xlPasteValues`. — Rachel Hettinger, May 08 '18 at 20:52
Here is how I added that `With WS Set Lastcell = WS.Range("A:O").Find(What:="*", SearchDirection:=xlPrevious) LastCellRowNumber = Lastcell.Row + 1 End With` and `> For i = LBound(shAry) To UBound(shAry) > shAry(i).UsedRange.Copy > wb.Activate > WS.Cells(Lastcell.Row + 1, 3).PasteSpecial xlPasteValues > Application.CutCopyMode = False > Next` But it is saying the 'object variable ir with blocks needs defined'? It is defined with set lastcell though I would think? — Darkcloud617, May 09 '18 at 12:36
I actually tried to set that to Range but it still brings up the error on this line `WS.Cells(LastCellRowNumber.Row + 1, 3).PasteSpecial xlPasteValues`. Here is how it is set `Dim LastCell As Range Dim LastCellRowNumber As Worksheet`. I also tried to dim LastCellRowNumber as worksheet but its the same error? Any ideas? — Darkcloud617, May 09 '18 at 14:43

score 1 · Accepted Answer · answered May 09 '18 at 16:57

This code finds the correct place to paste the data so nothing is lost or overwritten (e.g. first row with no data in columns C:).

Sub Rectangle1_Click()

Dim WS As Worksheet
Dim wb2 As Workbook
Dim vFile As Variant
Dim shAry As Variant
Dim sh As Variant

Set WS = ActiveWorkbook.Worksheets("Sheet 1")

'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
    1, "Select File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
Set wb2 = Workbooks.Open(vFile)

With wb2
    shAry = Array(.Sheets("Week 1"), .Sheets("Week 2"), .Sheets("Week 3"), .Sheets("Week 4"), .Sheets("Over 30"))
End With
For Each sh In shAry
    Dim LastCell As Range
    Set LastCell = WS.Range("C:O").Find(What:="*", SearchDirection:=xlPrevious)
    If LastCell Is Nothing Then Set LastCell = WS.Range("C1")
    Range(sh.Cells(1, 1), sh.Cells.SpecialCells(xlCellTypeLastCell)).Copy
    WS.Cells(LastCell.Row + 1, 3).PasteSpecial xlPasteValues
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True
wb2.Close False
End Sub

Note: I removed unnecessary code; for explanations, see previous answers.

You are brilliant. Exactly what I needed. I have a question though if you don't mind. I would still like to learn even though this code works. Why Dim and Set Lastcell below the `With wb2` array? Is this required? Also, was the problem originally that this needed another Variant (since sh is set to variant) to run through the array? Could that have been why it was not copying/pasting correctly? Thank you again for all of your assistance. Very very very appreciated. — Darkcloud617, May 09 '18 at 20:25
1) The Dim statement could be at the top as well; I put declarations just before the point where the variable is used; it maybe more of a .net thing and has no performance impact to declare inside the loop, btw. The Set LastCell needs to be where it is since the last cell changes at every loop. 2) I didn't run your original code so I can't say why it wasn't copying/pasting correctly before; it appears that your code was sound, but just needed a little tweaking (which is common). — Rachel Hettinger, May 09 '18 at 21:19

kolcinx · Answer 2 · 2018-05-07T20:08:29.100

0

Try this gem: cells.SpecialCells(xlCellTypeLastCell)
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-specialcells-method-excel

Try something along these lines:

Dim sh as Variant

For Each sh In shAry
    Range(sh.cells(1,1),sh.cells.SpecialCells(xlCellTypeLastCell)).Copy
    'wb.Activate 'Leave out. Dont need this.
    WS.Cells(Rows.Count, 3).End(xlUp).End(xlUp)(2).PasteSpecial xlPasteValues
    'Application.CutCopyMode = False 'If you really need this, put it after loop.
Next

Application.CutCopyMode = False

edited May 07 '18 at 20:08

answered May 07 '18 at 20:00

kolcinx

2,183
1
15
38

Thank you for looking into this but it still seems to have the same issues.I made a quick mock up. Here is the excel wkbk to copy from: https://ufile.io/fkz2z and the source wkbk: https://ufile.io/6r9yf. I just added a blue button with the code you have above included.. If you engage that macro you can see what is happening. It just does not want to seem to copy and paste orderly and mixes them up. Its driving me absolutely crazy. – Darkcloud617 May 07 '18 at 20:47

score 0 · Answer 3 · answered May 08 '18 at 03:01

That extra .End(xlUp) is what is causing your issues. (Even though you said you removed it in a comment, it's still in your sample files)

Here's your code refactored, including some other minor issues addressed, and inline comments (marked with <--- on what I changed

Sub Notes2()
    'Last row in column
    Dim ws As Worksheet, shAry As Variant, i As Long
    Dim AOFF As Range
    Dim rOWIS As Long              ' <-- better to use long
    Dim wb As Workbook, wb2 As Workbook
    Dim vFile As Variant
    Dim LastCell As Range          ' <-- Define all variables
    Dim LastCellRowNumber As Long  ' <--
    'Set source workbook
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("Sheet 4") ' <-- specify context
    'With ws                          ' <--- not used in rest of code
    '    Set LastCell = .Cells(.Rows.Count, "A").End(xlUp)
    '    LastCellRowNumber = LastCell.Row + 1
    'End With
    'Open the target workbook
    vFile = Application.GetOpenFilename("Excel-files,*.xlsx", _
        1, "Select File To Open", , False)
    'if the user didn't select a file, exit sub
    If vFile = False Then Exit Sub   ' <--  simpler
    Application.ScreenUpdating = False
    Set wb2 = Workbooks.Open(vFile)
    With wb2
        shAry = Array(.Sheets("Week 1"), .Sheets("Week 2"), .Sheets("Week 3"), .Sheets("Week 4"), .Sheets("Over 30"))
    End With
    For i = LBound(shAry) To UBound(shAry)
        shAry(i).UsedRange.Copy
        'wb.Activate                 ' <--- not needed
        ws.Cells(ws.Rows.Count, 3).End(xlUp)(2).PasteSpecial xlPasteValues ' <-- specify ws, remove extra End
        Application.CutCopyMode = False
    Next
    Application.ScreenUpdating = True
    'Close
    wb2.Close False
End Sub

It is so close to working but it still pastes off. Per the notes above from Rachel Hettinger we came up with a good paste code of `Set LastCell = WS.Range("C:O").Find(What:="*", SearchDirection:=xlPrevious)` and `WS.Cells(LastCell.Row + 1, 3).PasteSpecial xlPasteValues` but it is says 'object variable or with blocks needs defined'. Any ideas? I am at a complete loss with why this refuses to paste correctly. — Darkcloud617, May 09 '18 at 16:07
The above is supposed to only paste values in 'C' through 'O' from all 5 sheets, one under another, just as it appears in the 5 sheets (blanks included). Thank you so much for your time and all of the assistance. — Darkcloud617, May 09 '18 at 16:10

Copying and pasting data between workbooks in an array of sheets

3 Answers3