AppleScript to combine multiple Excel files into a single worksheet

痞子三分冷 提交于 2019-12-02 08:32:57

Tried and Tested in Excel 2011

My Assumptions

  1. The destination file has a sheet called Sheet1
  2. I am retrieving info from the 1st sheet of all files. Change as applicable.

CODE

I have commented the code so you should not have any problem understanding it. :)

Sub Sample()
    Dim wbI As Workbook, wbO As Workbook
    Dim lRowO As Long
    Dim lRowI As Long, lColI As Long
    Dim DestFile As Variant
    Dim RootFldr As String, FilesFolder As String, strFile As String

    '~~> Get the Root Folder
    RootFldr = MacScript("return (path to desktop folder) as String")

    '~~> Show the Folder Browser to select the folder which has the files
    FilesFolder = MacScript("(choose folder with prompt ""Please select the folder which has excel files""" & _
    "default location alias """ & RootFldr & """) as string")

    '~~> If user doesn't select anything then exit
    If FilesFolder = "" Then Exit Sub

    '~~> Show the File Select dialog for the output file
    DestFile = Application.GetOpenFilename("XLS8,XLS4")

    '~~> Open output file
    Set wbO = Workbooks.Open(DestFile)

    '~~> Get the next available row for writing
    lRowO = wbO.Sheets("Sheet1").Cells.Find(What:="*", _
            After:=wbO.Sheets("Sheet1").Range("A1"), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas).Row + 1

    '~~> Loop through each file in the folder
    strFile = Dir(FilesFolder)

    Do While Len(strFile) > 0
        '~~> Check for the file if it is csv,xls or xlsx
        If Right(strFile, 3) = "csv" Or _
        Right(strFile, 3) = "xls" Or _
        Right(strFile, 4) = "xlsx" Then
            '~~> Open the file from the folder
            Set wbI = Workbooks.Open(FilesFolder & strFile)

            With wbI
                '~~> Get the last row in the file from sheet #1
                lRowI = .Sheets(1).Cells.Find(What:="*", _
                        After:=.Sheets(1).Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row

                '~~> Get the last column in the file from sheet #1
                lColI = .Sheets(1).Cells.Find(What:="*", _
                        After:=.Sheets(1).Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column

                With .Sheets(1)
                    '~~> Copy the selected range
                    .Range(.Cells(1, 1), .Cells(lRowI, lColI)).Copy

                    '~~> Paste in destination file
                    wbO.Sheets("Sheet1").Range("A" & lRowO).PasteSpecial xlValues

                    '~~> Get the next available row for writing
                    lRowO = wbO.Sheets("Sheet1").Cells.Find(What:="*", _
                            After:=wbO.Sheets("Sheet1").Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row + 1
                End With
            End With
            '~~> Close the file after copying from it
            wbI.Close SaveChanges:=False
        End If
        strFile = Dir
    Loop

    MsgBox "Done"
End Sub
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!