VBA copy & paste code check

Swi1ch

New Member
Joined
Aug 15, 2019
Messages
4
Hi, i'm trying to write some VBA code to open several workbooks, copy a column, and past into the book I run the macro from. I need the data I copy over to all go into the same column. Here is my code:
Code:
Sub MeToo_Paste()
'Assign Report Book
Dim x As Workbook
'Assign Source Books
Dim y As Workbook
Dim z As Workbook
'Open Report Book
Set x = Workbooks.Open("C:\Filepath\Documents\Report.xlsm")
'Open Source Books
Set y = Workbooks.Open("C:\Filepath\Documents\Source 1.xlsx")
Set z = Workbooks.Open("C:\Filepath\Documents\Source 2.xlsx")
'Copy & Paste 1
y.Sheets("Sheet1").Range("B2:B500").Copy
x.Sheets("Sheet1").Range("B2").PasteSpecial
'Copy & Paste 2
z.Sheets("Sheet1").Range("B2:B500").Copy
x.Sheets("Sheet1").Range("B2").End(xlDown).Offset(1, 0).PasteSpecial
'Close
y.Close
z.Close
End Sub

The first problem I have here, is if one of the source books is open when I run the code from the report book, it won't copy & paste into the report book. Instead it pastes into that open source book, and I don't know why. I've assigned my report book to 'x' and only 'x' is used for pasting. Can anyone shed any light on why this would happen?
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Welcome to the board. Untested, so make copies of your files before testing, however replace all of the code above with below and try:
Code:
Sub M1()

    Dim RBS         As String: RBS = "C:\Filepath\Documents\Report.xlsm"
    Dim SBS         As String: SBS = "C:\Filepath\Documents\Source 1.xlsx"
    Dim v(1 To 2)   As Variant
    
    v(1) = Get_Data(SBS)
    v(2) = Get_Data(Replace(SBS, " 1.xlsx", " 2.xlsx"))
    
    With Workbooks.Open(RBS)
        With .Sheets("Sheet1")
            .Cells(2, 2).Resize(UBound(v(1), 1), UBound(v(1), 2)).Value = v(1)
            .Cells(2 + UBound(v(1), 1), 2).Resize(UBound(v(2), 1), UBound(v(2), 2)).Value = v(2)
        End With
    End With
        
    Erase v
    
End Sub

Private Function Get_Data(ByRef s As String) As Variant

    With Workbooks.Open(s, , True)
        With .Sheets("Sheet1")
            Get_Data = .Cells(2, 2).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1).Value
        End With
        ActiveWorkbook.Close
    End With
    
End Function
 
Last edited:
Upvote 0
Welcome to the board. Untested, so make copies of your files before testing, however replace all of the code above with below and try:
Code:
Sub M1()

    Dim RBS         As String: RBS = "C:\Filepath\Documents\Report.xlsm"
    Dim SBS         As String: SBS = "C:\Filepath\Documents\Source 1.xlsx"
    Dim v(1 To 2)   As Variant
    
    v(1) = Get_Data(SBS)
    v(2) = Get_Data(Replace(SBS, " 1.xlsx", " 2.xlsx"))
    
    With Workbooks.Open(RBS)
        With .Sheets("Sheet1")
            .Cells(2, 2).Resize(UBound(v(1), 1), UBound(v(1), 2)).Value = v(1)
            .Cells(2 + UBound(v(1), 1), 2).Resize(UBound(v(2), 1), UBound(v(2), 2)).Value = v(2)
        End With
    End With
        
    Erase v
    
End Sub

Private Function Get_Data(ByRef s As String) As Variant

    With Workbooks.Open(s, , True)
        With .Sheets("Sheet1")
            Get_Data = .Cells(2, 2).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1).Value
        End With
        ActiveWorkbook.Close
    End With
    
End Function

Thank you, it seems to work. I have no idea why it works however, I'm going to have a go at expanding it to pull data from more workbooks and see where I can get to with it.
 
Upvote 0
So I had a go and I think I got it to work. I also think I actually understand how the non-function part works, too.

Code:
Sub Attempt()
    Dim RBS         As String: RBS = "I:\H907 Design and Packaging\Project Spreadsheets\2019\Jon Testing\Report.xlsm"
    Dim SBS         As String: SBS = "I:\H907 Design and Packaging\Project Spreadsheets\2019\Jon Testing\Test 1.xlsx"
    Dim v(1 To 3)   As Variant
    
    v(1) = Get_Data(SBS)
    v(2) = Get_Data(Replace(SBS, " 1.xlsx", " 2.xlsx"))
    v(3) = Get_Data(Replace(SBS, " 1.xlsx", " 3.xlsx"))
    
    With Workbooks.Open(RBS)
        With .Sheets("Sheet1")
            .Cells(2, 2).Resize(UBound(v(1), 1), UBound(v(1), 2)).Value = v(1)
            .Cells(2 + UBound(v(1), 1), 2).Resize(UBound(v(2), 1), UBound(v(2), 2)).Value = v(2)
            .Cells(2 + UBound(v(1), 1) + UBound(v(2), 1), 2).Resize(UBound(v(3), 1), UBound(v(3), 2)).Value = v(3)
            
          
        End With
    End With
        
    Erase v
    
End Sub
Private Function Get_Data(ByRef s As String) As Variant
    With Workbooks.Open(s, , True)
        With .Sheets("Sheet1")
            Get_Data = .Cells(2, 2).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1).Value
        End With
        ActiveWorkbook.Close
    End With
    
End Function

The main thing I've not been able to understand how the function knows to open the sourcebooks. Value 's' appears to be assigned to the file path as a string, and ByRef says to me that the function is calling this value from the previous sub, but I cannot find how how and where (if at all) you set value 's'.
 
Upvote 0

Forum statistics

Threads
1,213,517
Messages
6,114,085
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top