Merge worksheets into 1 workbook

Papi

Well-known Member
Joined
May 22, 2007
Messages
1,592
This was Nories code to merge the first worksheet from 1 directory into 1 workbook with a worksheet for each one and it works great. What I need to do now is copy the first worksheet (Current) of each workbook in the folder into 1 worksheet also called Current and also another worksheet called Past into the same workbook also called Past. It needs to copy from row 15 to bottom of each worksheet. The files should only pickup Excel files and disregard .pdf and shortcuts etc.

Code:
Sub Merge2MultiSheets()
    Dim wbDst As Workbook
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim MyPath As String
    Dim strFilename As String
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    MyPath = "C:\Inventory\Documents"
    Set wbDst = Workbooks.Add(xlWBATWorksheet)
    strFilename = Dir(MyPath & "\*.xls", vbNormal)
    If Len(strFilename) = 0 Then Exit Sub
    Do Until strFilename = ""
            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
            Set wsSrc = wbSrc.Worksheets(1)
            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)
            wbSrc.Close False
        strFilename = Dir()
    Loop
    wbDst.Worksheets(1).Delete
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

Watch MrExcel Video

Forum statistics

Threads
1,109,029
Messages
5,526,340
Members
409,697
Latest member
christopherlewis1620

This Week's Hot Topics

Top