Copying a range of data from multiple workbooks to a master

[TerenceTitus]

Hi,

I am currently facing some issues running this VBA. I have searched and tried many sources, this is by far the furthest I have succeeded. Here is what I am trying to do:

I am trying to copy my data (B2:B52) in worksheet(Score) from multiple workbooks to a Master workbook with a sheet(Consolidated) to range(B3:B53). I am currently using this VBA, but it has an error of ("Run-time error 1005, Method 'Open' of object 'Workbooks' failed). Apparently it asked if I want to reopen my workbook that is already open. It is able to copy and paste into my Master, however, I am faced with this problem (debug in bold below).

Could someone advice me?

Sub CopyDataBetweenWorkbooks()
Dim wbSource As Workbook
Dim shTarget As Worksheet
Dim shSource As Worksheet
Dim strFilePath As String
Dim strPath As String
' Initialize some variables and
' get the folder path that has the files
Set shTarget = ThisWorkbook.Sheets("Consolidated")
strPath = GetPath
' Make sure a folder was picked.
If Not strPath = vbNullString Then
' Get all the files from the folder
strfile = Dir$(strPath & "*.xls", vbNormal)
Do While Not strfile = vbNullString
' Open the file and get the source sheet
Set wbSource = Workbooks.Open(strPath & strfile)
Set shSource = wbSource.Sheets("Score")

'Copy the data
Call CopyData(shSource, shTarget)
'Close the workbook and move to the next file.
wbSource.Close False
strfile = Dir$()
Loop
End If
End Sub
' Procedure to copy the data.
Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)
Const strRANGE_ADDRESS As String = "B2:B52"
Dim lCol As Long
'Determine the last column.
lCol = shTarget.Cells(3, shTarget.Columns.Count).End(xlToLeft).Column + 1
'Copy the data.
shSource.Range(strRANGE_ADDRESS).Copy
shTarget.Cells(3, lCol).PasteSpecial xlPasteValuesAndNumberFormats
' Reset the clipboard.
Application.CutCopyMode = xlCopy
End Sub

' Fucntion to get the folder path
Function GetPath() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Select a folder"
.Title = "Folder Picker"
.AllowMultiSelect = False
'Get the folder if the user does not hot cancel
If .Show Then GetPath = .SelectedItems(1) & ""
End With
End Function

 

[mrshl9898]

Do strPath and strfile have values when you are debugging?

I'm unfamiliar with GetPath in

[COLOR=#333333]strPath = GetPath[/COLOR]

Maybe try

[COLOR=#242729][FONT=Consolas]Application.ActiveWorkbook.Path[/FONT][/COLOR]

 

[jolivanes]

Could you be so kind and use code tags around your code.
At the beginning of the code use [ code] (no space) and at the end use [ /code] (again no space)
I have not tried your code but see if this makes a difference

Set wbSource = Workbooks.Open(strPath & "\" & strfile)

 

[TerenceTitus]

Hi jolivanes,

Thank you, however, i still get the error. It says here: "Masterbook.xlsm is already open. Reopening will cause changes you made to be discarded. Do you want to reopen Masterbook.xlsm?". At this point, i can see that my data is copied and pasted, but when i click yes, its gone.
Clicking no gives me error of run time.

Yes i will use the code parathesis next time, so sorry.

 

[TerenceTitus]

Hi mrshl9898,

No, strPath and strifle are not flagged when debugging.
I'll see if i can use yours. thank you!

 

[TerenceTitus]

Hi again,

So sorry, none of it works. It seems like my macro is trying to open my master workbook when it is already open.

Sub CopyDataBetweenWorkbooks()
    Dim wbSource As Workbook
    Dim shTarget As Worksheet
    Dim shSource As Worksheet
    Dim strFilePath As String
    Dim strPath As String
    ' Initialize some variables and
    ' get the folder path that has the files
    Set shTarget = ThisWorkbook.Sheets("Consolidated")
    strPath = GetPath
    ' Make sure a folder was picked.
    If Not strPath = vbNullString Then
        ' Get all the files from the folder
        strfile = Dir$(strPath & "*.xls", vbNormal)
        Do While Not strfile = vbNullString
            ' Open the file and get the source sheet
           [B] Set wbSource = Workbooks.Open(strPath & "" & strfile)[/B]
            Set shSource = wbSource.Sheets("Score")

            'Copy the data
            Call CopyData(shSource, shTarget)
            'Close the workbook and move to the next file.
            wbSource.Close False
            strfile = Dir$()
        Loop
    End If
End Sub
' Procedure to copy the data.
Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)
    Const strRANGE_ADDRESS As String = "B2:B52"
    Dim lCol As Long
    'Determine the last column.
    lCol = shTarget.Cells(3, shTarget.Columns.Count).End(xlToLeft).Column + 1
    'Copy the data.
    shSource.Range(strRANGE_ADDRESS).Copy
    shTarget.Cells(3, lCol).PasteSpecial xlPasteValuesAndNumberFormats
    ' Reset the clipboard.
    Application.CutCopyMode = xlCopy
End Sub

' Fucntion to get the folder path
Function GetPath() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Select a folder"
        .Title = "Folder Picker"
        .AllowMultiSelect = False
        'Get the folder if the user does not hot cancel
        If .Show Then GetPath = .SelectedItems(1) & ""
    End With
End Function