Copy data from multiple workbooks to a master workbook using VBA

Priyanka298

New Member
Joined
May 1, 2022
Messages
21
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi there,
I have tried the following code to copy and paste the data from source file to destination file, where the code works perfectly if the source file's record are just as value. But in my data, I have multiple files and that files contain records as formatted cells(have attached the image). I am not sure what's wrong in my code. Any help appreciated.
VBA Code:
[
Sub COPYPASTEQLD()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = Workbooks.Open("C:\Users\Priyanka.Patel\Desktop\VBA\Portfolio\Portfolio Dashboard Week Ending 2022 04 08 - All.xlsx")
    Dim LastRow As Long
    Const strPath As String = "C:\Users\Priyanka.Patel\Desktop\VBA\Week 5\QLD\- DONE\"
    ChDir strPath
    strExtension = Dir("C:\Users\Priyanka.Patel\Desktop\VBA\Week 5\QLD\- DONE\")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .Sheets("PDR Summary").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Sheets(1).Range("A3:BD" & LastRow).Copy
            wkbDest.Sheets("Active Proj - Detailed Report").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    
    Application.ScreenUpdating = True
End Sub

]
Also whenever I tried to open my Source file one message window pop-up. First image shows the error window, second and third is the image of my source file, if you check the cells contains some formulas for values. 

Many Thanks
Priyanka
 

Attachments

  • Screenshot (38).png
    Screenshot (38).png
    131.3 KB · Views: 33
  • Screenshot (39).png
    Screenshot (39).png
    150.2 KB · Views: 32
  • Screenshot (40).png
    Screenshot (40).png
    150.3 KB · Views: 33

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Hi mumps,

Have one question related to my previous question? Is it possible that I can open multiple source files by using single macros?

FOr ex; I have one .xlsb file in "C:\Users\Priyanka.Patel\Desktop\VBA\Week 5\QLD\- DONE\",
other will be in "C:\Users\Priyanka.Patel\Desktop\VBA\Week 5\QLD\- DONE\ABC\"

So, is it possible to with macros that in one script it will open the ABC folder and read the file inside the folder ABC, and same time also read the file inside "C:\Users\Priyanka.Patel\Desktop\VBA\Week 5\QLD\- DONE\"?

Many Thanks
 
Upvote 0
Do you have multiple files that you want to open in DONE and multiple files in ABC? Does ABC contain any other folders?
 
Upvote 0
Yes, there are multiple files (.xlsb) and folders in DONE, that I want to open but ABC does not contain any other folders most of the time.
 
Upvote 0
This macro assumes that the folders contain only the files you want to open and no others.
VBA Code:
Sub COPYPASTEQLD()
    Application.ScreenUpdating = False
    Dim fso, oFolder, oSubfolder, oFile, queue As Collection, wkbDest As Workbook, wkbSource As Workbook
    Set wkbDest = Workbooks.Open("C:\Mario\Forum Help\Portfolio Dashboard Week Ending 2022 04 08 - All.xlsx")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set queue = New Collection
    Dim MyFolder As String, MyFile As String
    MyFolder = "C:\Users\Priyanka.Patel\Desktop\VBA\Week 5\QLD\- DONE\"
    queue.Add fso.GetFolder(MyFolder)
    Do While queue.Count > 0
        Set oFolder = queue(1)
        queue.Remove 1
        For Each oSubfolder In oFolder.SubFolders
            queue.Add oSubfolder
        Next oSubfolder
        For Each oFile In oFolder.Files
            Set wkbSource = Workbooks.Open(oFile)
            With wkbSource.Sheets("PDR Summary")
                LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Range("A3:BD" & LastRow).Copy
                wkbDest.Sheets("Active Proj - Detailed Report").Cells(wkbDest.Sheets("Active Proj - Detailed Report").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                wkbSource.Close False
            End With
        Next oFile
    Loop
    Application.ScreenUpdating = True
End Sub
ABC does not contain any other folders most of the time
If ABC does at any time contain any subfolders, those files will also be opened.
 
Upvote 0
Solution
Hi mumps,

Thank you so much for the above code,

I got one error while running this code, however I am using this since you have provided it as a solution but today the error is weird.
MicrosoftTeams-image.png

It is like Run-time error 1004

And shown as in image, the same code works perfectly fine for other folders but for this ACT folder it will give an error. The path mentioned in error that is "W:\AAA PMO\-PM Reporting\2022\06 June\Week 2\ACT\.DS_Store\ " there is no file named ".DS_Store" inside ACT folder still it showing like this.

Could you please help me for this.

Thank you
 
Upvote 0
The backslash character ( \ ) is used to separate folder names so when you use 2022\06 June\ the macro is looking for a folder named "2022" and another folder named "06 June". Try renaming the path to "W:\AAA PMO\-PM Reporting\2022-06 June\Week 2\ACT\.DS_Store\ " (note the red hyphen replacing the backslash).
 
Upvote 0
06 June is folder inside the 2022 that’s why I put \ does it make any difference?
 
Upvote 0
And there is no file named .DS_Store inside the ACT. I am not getting why it shows
 
Upvote 0
Is there a folder named ".DS_Store" inside the ACT folder?
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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