Pull data from multiple workbooks to populate new workbook

[Mikeymike_W]

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

 

[Mikeymike_W]

Brilliant, worked perfectly.

Thanks so much for all your help on this

 

[Fluff]

Glad to help & thanks for the feedback

 

[tomlund]

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.

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.

 

[Fluff]

The resize should be 10 & not 34, but other than that I see no problems.

 

[tomlund]

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?

 

[tomlund]

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.

 

[tomlund]

Found the error, it was the antislash in the search-path... However, I got Run-time error '9': Subscription out of range whilst running

Rng.Offset(, 35).Value = .Sheets("EXEC SUM").Range("D10").Value

Do you possibly know the root of the issue?

 

[Fluff]

That suggests their is no sheet called EXEC SUM in the workbook that was just opened.

 

[tomlund]

Thanks again, you are awesome!

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

 

[Fluff]

That should no overwrite the values from col C, but you will only get the value from D17