VBA rollup specifies data for multiple workbooks

Tag:title   ati    Run    statusbar   item    end   als   value   xls   

Public Sub gatherfilesdata () application.screenupdating = False Application.DisplayAlerts = False application.cal Culation = xlcalculationmanual Application.statusbar = ">>>>>>>> program is running >>>>> >>> "on Error GoTo errhandler Dim StartTime, usedtime as Variant StartTime = VBA. Timer ' >>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>>>> Dim filepaths$ () Dim Filecount&, fileindex& Dim wb As Workbook Dim Sht As Worksheet Dim openwb As Workbook Dim opensht As W Orksheet Dim endrow As Long Dim NextRow as Long set wb = Application.thisworkbook Set SHT = wb. Worksheets.add (AFTER:=WB. Worksheets (WB). Worksheets.count)) with Application.filedialog (MsofilEdialogfilepicker). AllowMultiSelect = True. InitialFileName = Thisworkbook.path. Title = "Select Excel Workbook". Filters.clear. Filters.add "Excel Workbook", "*.xls*" If. Show =-1 Then FileCount =. Selecteditems.count ReDim FilePath (1 to filecount) for fileindex = 1 to FileCount Fil Epath (FileIndex) =. SelectedItems (FileIndex) Debug.Print FilePath (fileindex) Next fileindex Else M Sgbox "You have not selected any folders, this summary is interrupted!            "Exit Sub End If End with for fileindex = 1 to filecount If FileIndex = 1 Then NextRow = 1 Else with Sht Endrow =. Cells.find ("*",. Cells (1, 1), Xlvalues, Xlwhole, Xlbyrows, xlprevious). Row NextRow = Endrow + 1 End With end If Set OPENWB = Application.Workbooks.Open (F Ilepath (FileIndex)) Set Opensht = openwb.worksheets (1) OpenSht.UsedRange.CoPy Sht.cells (NextRow, 1) openwb.close False Next fileindex usedtime = VBA. Timer-starttime MsgBox "Time-consuming:" & Format (Usedtime, "0.000 seconds"), vbOKOnly, "Nextseven QQ 84857038" Errorexit:set W    b = Nothing Set Sht = Nothing Set openwb = Nothing Set Opensht = Nothing application.screenupdating = True    Application.DisplayAlerts = True Application.calculation = xlcalculationautomatic Application.statusbar = False Exit suberrhandler:if err.number <> 0 then MsgBox err.description & "! ", vbcritical," Excel Studio "' Debug.Print err.description err.clear Resume errorexit End ifend S Ub

　　

VBA rollup specifies data for multiple workbooks