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

JulesFalks

New Member
Joined
May 10, 2013
Messages
2
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!
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
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.
Code:
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
 
Upvote 0

JulesFalks

New Member
Joined
May 10, 2013
Messages
2
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.
 
Upvote 0

Forum statistics

Threads
1,186,813
Messages
5,959,959
Members
438,454
Latest member
Beverly Jarrell

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
Top