Consolidation Macro - All Input files in folder

[Vbalearner85]

Hi Vba champs,

1 Need help for macro which should consolidate n number of Input files(all saved in "Input" folder) in 1 summary file
2.Each Input file has same format/ 2 tabs - 1-Input Details 2. Summary. Need each tab in Input file to consolidate(copy as values/No format copy) separately in 2 existing tabs by same names in "Summary file". Tab 1 has data from row 4 in each Input file and Tab 2 has data from row 6 to be consolidated.
3.All Input files have same no. of columns(around 10)/same headers(so no need to copy headers.it should only copy data in rows.in summary file ...no. of rows will vary for each input file)
4.Macro should take auto path for all Input files from sub-folder "Input" where main "summary" file is saved

Thanks in Advance

 

[DanteAmor]

Try this

Option Explicit
Sub Consolidation_Macro()
    Dim wb1 As Workbook, wb2 As Workbook, sh1 As Worksheet, sh2 As Worksheet, sh As Worksheet
    Dim wPath As String, wFiles As Variant, e1 As Boolean, e2 As Boolean
    Dim lr1 As Long, lr2 As Long
    
    Application.ScreenUpdating = False
    
    Set wb1 = ThisWorkbook
    Set sh1 = wb1.Sheets("Input Details")
    Set sh2 = wb1.Sheets("Summary")
    
    wPath = wb1.Path & "\Input\"
    
    wFiles = Dir(wPath & "*.xlsx")
    Do While wFiles <> ""
        Set wb2 = Workbooks.Open(wFiles)
        e1 = False
        e2 = False
        For Each sh In wb2.Sheets
            If LCase(sh.Name) = LCase(sh1.Name) Then e1 = True
            If LCase(sh.Name) = LCase(sh1.Name) Then e2 = True
        Next
        If e1 And e2 Then
            lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row + 1
            lr2 = wb2.Sheets(sh1.Name).Range("A" & Rows.Count).End(xlUp).Row
            wb2.Sheets(sh1.Name).Range("A4:J" & lr2).Copy
            sh1.Range("A" & lr1).PasteSpecial xlPasteValues
            
            lr1 = sh2.Range("A" & Rows.Count).End(xlUp).Row + 1
            lr2 = wb2.Sheets(sh2.Name).Range("A" & Rows.Count).End(xlUp).Row
            wb2.Sheets(sh2.Name).Range("A6:J" & lr2).Copy
            sh2.Range("A" & lr1).PasteSpecial xlPasteValues
        End If
        wb2.Close False
        wFiles = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

 

[Vbalearner85]

Appreciate your effort....
Code is giving runtime error "1004" "Sorry..couldn't locate A.xlsx.. could be moved.renamed or deleted"..A.xlsx is first Input file. Not sure whats wrong..cross-checked that tab names match in consolidation and Input files at my end....

 

[DanteAmor]

Appreciate your effort....
Code is giving runtime error "1004" "Sorry..couldn't locate A.xlsx.. could be moved.renamed or deleted"..A.xlsx is first Input file. Not sure whats wrong..cross-checked that tab names match in consolidation and Input files at my end....

On which line does the macro stop?

Change this line

Set wb2 = Workbooks.Open(wFiles)

By

[COLOR=#333333]Set wb2 = Workbooks.Open([/COLOR][COLOR=#333333]wPath & [/COLOR][COLOR=#333333]wFiles)[/COLOR]

 

[Vbalearner85]

Fantastic... Works like as charm now..as desired...Tested it with changing number of Input files..works perfectly!!!

Many Thanks!!.. for your valuable time

 

[DanteAmor]

Fantastic... Works like as charm now..as desired...Tested it with changing number of Input files..works perfectly!!!

Many Thanks!!.. for your valuable time

I'm glad to help you. Thanks for the feedback.