I have multiple excel documents that are protected, so the users can't alter any of the information. I am using the code below and keep getting an error, Method'Copy' of object'_Worksheet' failed. Wasn't sure why I was getting that error. I have done some research and can't seem to find the answer to the problem.
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
countFiles = 0
countSheets = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkCurBook = ActiveWorkbook
For Each fnameCurFile In fnameList
countFiles = countFiles + 1
Set wbkSrcBook = Workbooks.Open(Filename:=(fnameCurFile), UpdateLinks:=0)
For Each wksCurSheet In wbkSrcBook.Sheets
countSheets = countSheets + 1
wksCurSheet.Copy After:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
wbkSrcBook.Close SaveChanges:=False
Sheets("STB").Select
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Dim answer As Integer
answer = MsgBox("Import complete, would you like to roll up the units?", vbQuestion + vbYesNo + vbDefaultButton2, "Import complete")
If answer = vbYes Then
Call Roll_Up
Else
End If
Application.ScreenUpdating = True
End If
Else
MsgBox "No files selected"
End If
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
countFiles = 0
countSheets = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkCurBook = ActiveWorkbook
For Each fnameCurFile In fnameList
countFiles = countFiles + 1
Set wbkSrcBook = Workbooks.Open(Filename:=(fnameCurFile), UpdateLinks:=0)
For Each wksCurSheet In wbkSrcBook.Sheets
countSheets = countSheets + 1
wksCurSheet.Copy After:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
wbkSrcBook.Close SaveChanges:=False
Sheets("STB").Select
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Dim answer As Integer
answer = MsgBox("Import complete, would you like to roll up the units?", vbQuestion + vbYesNo + vbDefaultButton2, "Import complete")
If answer = vbYes Then
Call Roll_Up
Else
End If
Application.ScreenUpdating = True
End If
Else
MsgBox "No files selected"
End If