Page 1 of 2 12 LastLast
Results 1 to 10 of 16

Macro to select multiple .xls files from same folder and add to new workbook

This is a discussion on Macro to select multiple .xls files from same folder and add to new workbook within the Excel Questions forums, part of the Question Forums category; Hi, Could someone help me out with the following. I would like a macro that when run will allow me ...

  1. #1
    Board Regular
    Join Date
    Jan 2011
    Posts
    151

    Default Macro to select multiple .xls files from same folder and add to new workbook

    Hi,

    Could someone help me out with the following. I would like a macro that when run will allow me to open a folder and select .xls files in this folder and add the sheets in each file to one workbook. (each file only has one sheet but all have different names).

    I'd like each sheet to be copied to new workbook as seperate tabs. (if the original tab name could be kept would be great)

    I have done many searching but couldnt find a thread that suits. Closest I found was this:

    Using VBA scripts to Combine multiple workbooks of single worksheet to a single workbook of multiple worksheets

    Any help would be much appreciated.

    This code kinda of works but doesnt if the tab in the files is not named sheet1:

    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:\MyPath" ' change to suit
    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

  2. #2
    Board Regular
    Join Date
    Feb 2011
    Location
    Brampton, Ontario
    Posts
    496

    Default Re: Macro to select multiple .xls files from same folder and add to new workbook

    Try this


    Code:
    Dim oeffnen, n As Integer
    Application.ScreenUpdating = False
    oeffnen = Application _
    .GetOpenFilename(fileFilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
    If IsArray(oeffnen) = False Then GoTo ENDE
    For n = 1 To UBound(oeffnen)
        Workbooks.OpenText oeffnen(n)
        ActiveWorkbook.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Workbooks(Mid(oeffnen(n), InStrRev(oeffnen(n), "\") + 1)).Close False
    Next n
    ENDE:
    Application.ScreenUpdating = True

  3. #3
    Board Regular
    Join Date
    Feb 2011
    Location
    Brampton, Ontario
    Posts
    496

    Default Re: Macro to select multiple .xls files from same folder and add to new workbook

    opps

    code should be 'Workbooks.Open' - not opentext - sorry I am reading CSV files

  4. #4
    Board Regular
    Join Date
    Jan 2011
    Posts
    151

    Default Re: Macro to select multiple .xls files from same folder and add to new workbook

    Hi,

    Thanks for the reply. I'll get back to you on Monday on the success of it.

    Thanks

  5. #5
    Board Regular
    Join Date
    Feb 2011
    Location
    Brampton, Ontario
    Posts
    496

    Default Re: Macro to select multiple .xls files from same folder and add to new workbook

    ok - sounds good - I am travelling from Tuesday and onwards until Sunday - so will not reply to any messages in that period - But I think the code will do what u r lokin 4. else google VBA+getopenfilename - u will loads of hits
    xl2007 - Windows-7 & XP

    Does xl hate the number 255 ?
    biggest limitation - drives me insane

  6. #6
    Board Regular
    Join Date
    Jan 2011
    Posts
    151

    Default Re: Macro to select multiple .xls files from same folder and add to new workbook

    Hi Rasm,

    Thanks for the code. I tried it out and it does work but doesnt work on the excel sheets im trying to move unfortunatly for some reason.

    Getting the following error:

    Run Time Error '1004':
    Copy Method of Worksheet class failed

    and when debug its pointing to this line:

    ActiveWorkbook.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

    Maybe you have another solution? But it does work on other excel files.

  7. #7
    Board Regular
    Join Date
    Jan 2011
    Posts
    151

    Default Re: Macro to select multiple .xls files from same folder and add to new workbook

    Hi Rasm,

    Any idea on the above?

  8. #8
    Board Regular
    Join Date
    Feb 2011
    Location
    Brampton, Ontario
    Posts
    496

    Default Re: Macro to select multiple .xls files from same folder and add to new workbook

    Try This - you will have to change to suit your needs - right now it allows you to select multiple files - not sure if that is what you want

    Code:
    Private Sub CommandButton1_Click()
        FilesToOpen = Application.GetOpenFilename("Excel Files (*.xl*)," & "*.xl*", 1, "Select Excel File", "Open", MultiSelect:=True)
        
        For i = 1 To UBound(FilesToOpen)
            Workbooks.Open FilesToOpen(i)
            With ActiveWorkbook
                For ii = 1 To Sheets.Count
                    .Sheets(ii).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                Next ii
            End With
        Next i
    End Sub
    xl2007 - Windows-7 & XP

    Does xl hate the number 255 ?
    biggest limitation - drives me insane

  9. #9
    Board Regular
    Join Date
    Feb 2011
    Location
    Brampton, Ontario
    Posts
    496

    Default Re: Macro to select multiple .xls files from same folder and add to new workbook

    you may want to close opened file after it is copied - up yo you


    Code:
    Private Sub CommandButton1_Click()
        FilesToOpen = Application.GetOpenFilename("Excel Files (*.xl*)," & "*.xl*", 1, "Select Excel File", "Open", MultiSelect:=True)
        
        For i = 1 To UBound(FilesToOpen)
            Workbooks.Open FilesToOpen(i)
            With ActiveWorkbook
                For ii = 1 To Sheets.Count
                    .Sheets(ii).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                Next ii
                .Close 'closes file after it is copied
            End With
           
        Next i
    End Sub
    xl2007 - Windows-7 & XP

    Does xl hate the number 255 ?
    biggest limitation - drives me insane

  10. #10
    Board Regular
    Join Date
    Jan 2011
    Posts
    151

    Default Re: Macro to select multiple .xls files from same folder and add to new workbook

    Hi Rasm,

    I have the code as follows but still didnt work. It does work on some excel files however not on the ones im trying to add. On some the cells there is formula's:

    IF(PARM_Z_MultiPeriodReport=1,W9,X9)

    what I used to have to do was copy the sheet, then paste special values back onto the sheet and copy again so I could copy and paste to another sheet easily. So maybe thats why it is not working?

    On the sheets im trying to add

    Sub Merge2MultiSheets()
    Dim oeffnen, n As Integer
    Application.ScreenUpdating = False
    oeffnen = Application _
    .GetOpenFilename(fileFilter:="Excel Files (*.xls), *.xls", MultiSelect:=True)
    If IsArray(oeffnen) = False Then GoTo ENDE
    For n = 1 To UBound(oeffnen)
    Workbooks.OpenText oeffnen(n)
    ActiveWorkbook.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Workbooks(Mid(oeffnen(n), InStrRev(oeffnen(n), "\") + 1)).Close False
    Next n
    ENDE:
    Application.ScreenUpdating = True
    End Sub
    Private Sub CommandButton1_Click()
    FilesToOpen = Application.GetOpenFilename("Excel Files (*.xl*)," & "*.xl*", 1, "Select Excel File", "Open", MultiSelect:=True)

    For i = 1 To UBound(FilesToOpen)
    Workbooks.Open FilesToOpen(i)
    With ActiveWorkbook
    For ii = 1 To Sheets.Count
    .Sheets(ii).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Next ii
    .Close 'closes file after it is copied
    End With

    Next i
    End Sub

Page 1 of 2 12 LastLast

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com