none
MACRO - Select mulitple files within a folder and extract sheet from these files RRS feed

  • Question

  • Hi there,

    I need to consolidate multiple spreadsheets (name: reports on xxx where xxx is the date and time) into one workbook (name: output) for every month. E.g.  For June, I will have to open 21 spreadsheets on 06/30/2012 (because there are 21 weekdays in June and those "reports on xxx" will only be generated on weekdays) and then one by one copy and paste to the "output" workbook. This is ridiculous (since I need to do this for every month, June, July, August,..... gosh!) and I believe there are codes to do this. Could anyone please advise what can I do? The following are some details:

    1) For "reports on xxx":
        a) The name of the report is only partly consistent: e.g. Report-2012-06-21-2101
                                                                                          Report-2012-06-20-2054 ------- Consistent for Reports-2012-06
                                                                                                                                                   Inconsistent for -2054/-2101 (this is the time)
    Therefore, I am wondering will there be any codes about "Searching the file name starting with xxxxx(Reports-2012-06) within the same folder and open them one by one".
       b) After opening the file, there is only one sheet and I just need to copy the whole sheet and place to the workbook "output"
              ----> I will need to place each reports consecutively in workbook "output" in the same sheet, I mean:
                      "Reports on xxx"                                                      "output"    
       2012-06-21-2101            1      20                                            1        20
                                               2      22                                            2        22
                                               3      12   --------------------->             3         12
       2012-06-20-2054            1      32                                             4         32
                                               2      98                                             5         98
                                               3      44                                             6         44
    *** The sequence of reports is not important, it can be 06-20 on top and 06-21 following that ***

    So, what I want is:
    ---> search the name starting with" Reports-2012-06" and open them one by one and copy them one by one and paste them one by one to workbook "output" consecutively in one sheet

    Is there any code for this? Thanks in advance !!!!!!!



    • Edited by Jackynck Friday, June 22, 2012 9:30 AM
    Friday, June 22, 2012 9:28 AM

Answers

  • Try this macro. The output sheet should be the active sheet when you run the macro.

    Sub ProcessWorkbooks()
        Dim wbkIn As Workbook
        Dim wshIn As Worksheet
        Dim wshOut As Worksheet
        Dim strPath As String
        Dim strFile As String
        Dim r As Long
        With Application.FileDialog(4) ' msoFileDialogFolderPicker
            If .Show Then
                strPath = .SelectedItems(1)
                If Right(strPath, 1) <> "\" Then
                    strPath = strPath & "\"
                End If
            Else
                MsgBox "No folder selected.", vbExclamation
                Exit Sub
            End If
        End With
        strFile = InputBox("Enter month (yyyy-mm):", , Format(Date, "yyyy-mm"))
        If strFile = "" Then
            MsgBox "No month specified.", vbExclamation
            Exit Sub
        End If
        Application.ScreenUpdating = False
        Set wshOut = ActiveSheet
        If wshOut.Range("A1") = "" Then
            wshOut.Range("A1") = strFile
        End If
        strFile = Dir(strPath & strFile & "*.xls*")
        Do While strFile <> ""
            Set wbkIn = Workbooks.Open(strPath & strFile)
            Set wshIn = wbkIn.Worksheets(1)
            r = wshOut.Cells.Find(What:="*", SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row + 1
            wshIn.UsedRange.Copy Destination:=wshOut.Range("A" & r)
            wbkIn.Close SaveChanges:=False
            strFile = Dir
        Loop
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by Jackynck Monday, June 25, 2012 6:54 AM
    Friday, June 22, 2012 9:55 AM

All replies

  • Try this macro. The output sheet should be the active sheet when you run the macro.

    Sub ProcessWorkbooks()
        Dim wbkIn As Workbook
        Dim wshIn As Worksheet
        Dim wshOut As Worksheet
        Dim strPath As String
        Dim strFile As String
        Dim r As Long
        With Application.FileDialog(4) ' msoFileDialogFolderPicker
            If .Show Then
                strPath = .SelectedItems(1)
                If Right(strPath, 1) <> "\" Then
                    strPath = strPath & "\"
                End If
            Else
                MsgBox "No folder selected.", vbExclamation
                Exit Sub
            End If
        End With
        strFile = InputBox("Enter month (yyyy-mm):", , Format(Date, "yyyy-mm"))
        If strFile = "" Then
            MsgBox "No month specified.", vbExclamation
            Exit Sub
        End If
        Application.ScreenUpdating = False
        Set wshOut = ActiveSheet
        If wshOut.Range("A1") = "" Then
            wshOut.Range("A1") = strFile
        End If
        strFile = Dir(strPath & strFile & "*.xls*")
        Do While strFile <> ""
            Set wbkIn = Workbooks.Open(strPath & strFile)
            Set wshIn = wbkIn.Worksheets(1)
            r = wshOut.Cells.Find(What:="*", SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row + 1
            wshIn.UsedRange.Copy Destination:=wshOut.Range("A" & r)
            wbkIn.Close SaveChanges:=False
            strFile = Dir
        Loop
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
    End Sub


    Regards, Hans Vogelaar

    • Marked as answer by Jackynck Monday, June 25, 2012 6:54 AM
    Friday, June 22, 2012 9:55 AM
  • Cant believe there is really a code for this....... thanks its awesome !!!!!!!!!!!!!!!!!!!!!!!!
    Monday, June 25, 2012 6:54 AM