Macro to Pull in select tabs from many files into one master

[JulesFalks]

Hi All,
I am not only very new to this forum but also to excel macros. Pretty much what I am trying to do is write a macro that will pull two tabs labeled "XXXXMarch" "XXXXPTD" (the x's represent numbers) from each file within a designated folder and copy them into a master file. Can anyone help with this? Please let me know if there is any other information you need to help answer this question, any advise would be greatly appreciated!

 

[JLGWhiz]

It will require the folder path(s) be provided. It would be helpful to know if the worksheets have the same layout for column headers and do you want the consolidated sheet to use the same headers. If so, which row(s) comprise the header and how many columns. A standard procedure using the Dir function will retrieve all files in the folder path and copy the data to a consolidated worksheet in the same order as they appear in the directory listing, usually numeric-alpha. The worksheets would be retrieved in the order that they are arranged in the procedure that retrieves them. Unless otherwise specified, there will be no obvious distinction of which data came from which workbook or worksheet. Here is the generic code to do what you want, but it will not work without the folder path.

Sub combine()
Dim sh1 As Worksheet, sh2 As Worksheet, wb As Workbook, fPath As String, fName As String
Dim lr As Long, lr2 As Long, lc As Long, lc2 As Long, dWb As Workbook, dSh As Worksheet
Set dWb = ThisWorkbook
Set dSh = dWb.Sheets(1) 'Edit sheet name
fPath = "C:\TEMP" 'Folder path goes here
    If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & "*.xl*")
    Do While fName <> ""
        On Error Resume Next
        Set wb = Workbooks.Open(fName)
        For Each sh1 In wb.Sheets
            If sh1.Name Like "*March" Then
                lr = sh1.Cells.Find(What:="*", After:=sh1.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
                lc = sh1.Cells.Find(What:="*", After:=sh1.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
                SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
                sh1.Range("A2", sh1.Cells(lr, lc)).Copy dSh.Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next
        For Each sh2 In wb.Sheets
            If sh2.Name Like "*PTD" Then
                lr2 = sh2.Cells.Find(What:="*", After:=sh2.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
                lc2 = sh2.Cells.Find(What:="*", After:=sh2.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, _
                SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
                sh2.Range("A2", sh2.Cells(lr2, lc2)).Copy dSh.Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next        
        On Error GoTo 0
        wb.Close False
        fName = Dir
    Loop
MsgBox "Files are copied"
End Sub

 

[JulesFalks]

Hi Whiz thanks for the response! The worksheets have the same layout for column headers however I just realized rows 6,8,12 must be deleted from each file before they will correctly populate the master file. Row 13 comprises the header and there are 12 columns. I will be creating a folder called monthly reports and then a subfolder for each month.