Pull data from multiple workbooks to populate new workbook

Mikeymike_W

Board Regular
Joined
Feb 25, 2016
Messages
171
Hi,

I want to create a spreadsheet that will pull data from a form that my clients use.

There will be many of these forms and each one will have a slightly different file name but be stored in the same folder (C:\Users\MWa\Desktop\VBA Test\filename)

I want to copy the exact same cells from sheet 3 in the form to the new spreadsheet.

There will be many of these forms within the folder at one time. Can the code read all of these and add a new line in the spreadsheet for each form with one click?

I realise I'm asking a lot but I'm hoping the excel gods are watching over me :)

Many thanks in advance,

Mike
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Glad to help & thanks for the feedback
 
Upvote 0
Hey @Fluff !

A couple of years has past, and I'm trying to re-create the code by adjusting some inputs, however, with little success.

Excel Formula:
Sub ConsolidateWbks()

  Dim Pth As String
    Dim MstSht As Worksheet
    Dim fname As String
    Dim Rng As Range
    
Application.ScreenUpdating = False

    Pth = "C:\Users\Tom\Test IIK"
    Set MstSht = ThisWorkbook.Sheets("Test1")
    fname = Dir(Pth & "*xls*")
    Do While Len(fname) > 0
        Workbooks.Open (Pth & fname)
        With Workbooks(fname)
            Set Rng = MstSht.Range("E" & Rows.Count).End(xlUp).Offset(1)
            Rng.Resize(, 34).Value = Application.Transpose(.Sheets("EXEC SUM").Range("D17:D26").Value)
            Rng.Offset(, 35).Value = .Sheets("EXEC SUM").Range("D10").Value
            Rng.Offset(, 36).Value = .Sheets("INPUT - SDU").Range("F4").Value
            Application.DisplayAlerts = False
            .Close , False
            Application.DisplayAlerts = True
        End With
        fname = Dir
    Loop

End Sub

Could you help me depcit what might be the root of the problem? I don´t recieve any error codes.
 
Upvote 0
The resize should be 10 & not 34, but other than that I see no problems.
 
Upvote 0
Thanks for the superfast response. I'm a complete rookie, so bare with me.
When I run the code, nothing happens. Similarly, when I step into the code everything clears (yellow and then jumps to the next command).

What does the "E" stand for in MstSht.Range? Is that an issue?
 
Upvote 0
How does the code know where to insert its first value? In which colum/row does it insert the first retrieved value? When i run the code, unfortuantely nothing happends which i dont understand. I created some dummy excel files which i retrieve the values from in order to refute that as a possible issue.
 
Upvote 0
Found the error, it was the antislash in the search-path... However, I got Run-time error '9': Subscription out of range whilst running
Excel Formula:
Rng.Offset(, 35).Value = .Sheets("EXEC SUM").Range("D10").Value
Do you possibly know the root of the issue?
 
Upvote 0
That suggests their is no sheet called EXEC SUM in the workbook that was just opened.
 
Upvote 0
Thanks again, you are awesome!

Excel Formula:
Sub ConsolidateWbks()

  Dim Pth As String
    Dim MstSht As Worksheet
    Dim fname As String
    Dim Rng As Range
    
Application.ScreenUpdating = False

    Pth = "C:\Users\Tom\Documents\"
    Set MstSht = ThisWorkbook.Sheets("Test1")
    fname = Dir(Pth & "*xls*")
    Do While Len(fname) > 0
        Workbooks.Open (Pth & fname)
        With Workbooks(fname)
            Set Rng = MstSht.Range("B" & Rows.Count).End(xlUp).Offset(1)
            Rng.Resize(, 9).Value = Application.Transpose(.Sheets("EXEC SUM").Range("C6:C14").Value)
          [B]  Rng.Offset(, 10).Value = Application.Transpose(.Sheets("EXEC SUM").Range("D17:D26").Value)[/B]
            Rng.Offset(, 50).Value = .Sheets("Värden").Range("B6").Value
            Rng.Offset(, 51).Value = .Sheets("Värden").Range("B23").Value
            Rng.Offset(, 52).Value = .Sheets("Värden").Range("B24").Value
            Application.DisplayAlerts = False
            .Close , False
            Application.DisplayAlerts = True
        End With
        fname = Dir
        
    Loop

End Sub

How do i add multiple ranges? As of now it retrieves the first range (C6:C14) and then writes over those rows & cells with the other range (D17:D26). How do i solve this...? Tried google but need your great expertise
 
Upvote 0
That should no overwrite the values from col C, but you will only get the value from D17
 
Upvote 0

Forum statistics

Threads
1,223,954
Messages
6,175,603
Members
452,660
Latest member
Zatman

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