I have a macro that needs to open a few excel files and copy data from those files and paste them into the macro file in a sheet named "Consolidated". The macro goes to a specified path, counts the number of files in the folder and then loops through to open a file, copy the contents and then save and close the file.
The macro runs perfectly on my system but not on the users systems.
The error i am receiving during the looping process is "Runtime Error '9' Subscript out of range". The line on which this error pops up is
Set wb = Workbooks.Open(Filename:=.FoundFiles(file_count)) At first i thought that the files might be opening slower than the code execution so i added wait time of 5 seconds before and after the above line...but to no avail.
The code is listed below
Sub grab_data() Application.ScreenUpdating = False Dim rng As Range srow = ThisWorkbook.Sheets("Consolidated Data").Cells(65536, 11).End(xlUp).Row 'Number of filled rows in column A of control Sheet ThisWorkbook.Sheets("Control Sheet").Activate rawfilepth = Sheets("Control Sheet").Cells(65536, 1).End(xlUp).Row 'Loop to find the number of excel files in the path in each row of the Control Sheet For folder_count = 2 To rawfilepth wkbpth = Sheets("Control Sheet").Cells(folder_count, 1).Value With Application.FileSearch .LookIn = wkbpth .FileType = msoFileTypeExcelWorkbooks .Execute filecnt = .FoundFiles.Count 'Loop to count the number of sheets in each file For file_count = 1 To filecnt Application.Wait (Now + TimeValue("0:00:05")) Set wb = Workbooks.Open(Filename:=.FoundFiles(file_count)) Application.Wait (Now + TimeValue("0:00:05")) filenm = ActiveWorkbook.Name For sheet_count = 1 To Workbooks(filenm).Sheets.Count If Workbooks(filenm).Sheets(sheet_count).Name <> "Rejected" Then Workbooks(filenm).Sheets(sheet_count).Activate ActiveSheet.Columns("a:at").Select Selection.EntireColumn.Hidden = False shtnm = Trim(ActiveSheet.Name) lrow = ActiveSheet.Cells(65536, 11).End(xlUp).Row If lrow = 1 Then lrow = 2 For blank_row_count = 2 To lrow If ActiveSheet.Cells(blank_row_count, 39).Value = "" Then srow = ActiveSheet.Cells(blank_row_count, 39).Row Exit For End If Next blank_row_count For uid = srow To lrow ActiveSheet.Cells(uid, 40).Value = ActiveSheet.Name & uid Next uid ActiveSheet.Range("a" & srow & ":at" & lrow).Copy ThisWorkbook.Sheets("Consolidated Data").Activate alrow = ThisWorkbook.Sheets("Consolidated Data").Cells(65536, 11).End(xlUp).Row ThisWorkbook.Sheets("Consolidated Data").Range("a" & alrow + 1).Activate ActiveCell.PasteSpecial xlPasteValues ThisWorkbook.Sheets("Consolidated Data").Range("z" & alrow + 1).Value = shtnm ThisWorkbook.Sheets("Consolidated Data").Range("z" & alrow + 1 & ":z" & (alrow+lrow)).Select Selection.FillDown ThisWorkbook.Sheets("Consolidated Data").Range("ap" & alrow + 1).Value = wkbpth ThisWorkbook.Sheets("Consolidated Data").Range("ap" & alrow + 1 & ":ap" & (alrow + lrow)).Select Selection.FillDown ThisWorkbook.Sheets("Consolidated Data").Range("ao" & alrow + 1).Value = filenm ThisWorkbook.Sheets("Consolidated Data").Range("ao" & alrow + 1 & ":ao" & (alrow + lrow)).Select Selection.FillDown Workbooks(filenm).Sheets(sheet_count).Activate ActiveSheet.Range("am" & srow & ":am" & lrow).Value = "Picked" ActiveSheet.Columns("b:c").EntireColumn.Hidden = True ActiveSheet.Columns("f:f").EntireColumn.Hidden = True ActiveSheet.Columns("h:i").EntireColumn.Hidden = True ActiveSheet.Columns("v:z").EntireColumn.Hidden = True ActiveSheet.Columns("aa:ac").EntireColumn.Hidden = True ActiveSheet.Columns("ae:ak").EntireColumn.Hidden = True End If Next sheet_count Workbooks(filenm).Close True Next file_count End With Next folder_count Application.ScreenUpdating = True End Sub Thanks in advance for your help.