Macro for Multiple workbooks with multiple sheets

[politicalangel]

Hi,
I have multiple workbooks (for each month) that has multiple sheets (for each region by MDT and QTD). All saved in the same folder
I would like a macros to pull the data from each workbook (MTD tabs) and populate my master workbook as a trend summary
My Master workbook has 3 tabs (one for each region)- I would like to gather data into this 3 tabs to create a annual trend by region, which in turn I can create trend graphs to populate my power point slides
Does anyone know of any MACROS/VBAs I can use?

Attached is the template- Your help would be greatly appreciated

 

[Marc L]

Hi !

A starter to paste to the summary module ThisWorkbook :​

Sub Demo1()
      Dim F$, V, N&, R&, Rg As Range
          F = Dir(Me.Path & "\*data.xlsx")
    While F > ""
          V = Application.Match(Split(F)(1), Worksheets(1).UsedRange.Rows(1), 0)
        If IsNumeric(V) Then
            With GetObject(Me.Path & "\" & F)
                For N = 1 To .Worksheets.Count
                    With .Worksheets(N).[A1].CurrentRegion
                            R = 2
                        For Each Rg In .Rows("2:5").Columns(2).Resize(, .Columns.Count - 1)
                            Worksheets(N).Cells(R, V).Resize(4).Value = Rg.Value
                            R = R + 4
                        Next
                    End With
                Next
                   .Close False
            End With
        End If
          F = Dir
    Wend
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Marc L]

Another way to paste to the module ThisWorkbook :​

Sub Demo2()
   Const E = ";Extended Properties=""Excel 12.0;HDR=NO"""
     Dim Cn As Object, P$, W, F$, C, Ws As Worksheet, V, R&, N&
     Set Cn = CreateObject("ADODB.Connection")
     Application.ScreenUpdating = False
          P = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Me.Path & "\"
          W = [ROW(1:4)]
          F = Dir(Me.Path & "\*data.xlsx")
    While F > ""
          C = Application.Match(Split(F)(1), Worksheets(1).UsedRange.Rows(1), 0)
        If IsNumeric(C) Then
                     Cn.Open P & F & E
            For Each Ws In Worksheets
                With Cn.Execute("SELECT * FROM [" & Ws.Name & "$" & [B2].Resize(4, 4 + (Ws.Name = "Asia")).Address(0, 0) & "]")
                   V = .GetRows
                       .Close
                End With
                    R = 2
                For N = 1 To UBound(V) + 1
                    Ws.Cells(R, C).Resize(4).Value = Application.Index(V, N, W)
                    R = R + 4
                Next
            Next
                     Cn.Close
        End If
          F = Dir
    Wend
     Set Cn = Nothing
     Application.ScreenUpdating = True
End Sub

You may Like it !
​

 

[politicalangel]

Quick question:
Could you explain to me how this works:

F = Dir(Me.Path & "\*data.xlsx")

Error: Invalid use of Me Keyword

 

[Marc L]

Error as the code is not located where expected as written in dark red !

This codeline starts to search for the first file.
See in VBA inner help for Dir & Me statements …
​