Code to copy same sheet from several workbooks to one not working

[mystie]

Hello everybody!

I am using the following code to copy the same sheet from several workbooks into a new workbook.

Sub CopySameSheetFrmWbs()
    Dim wbOpen As Workbook
    Dim wbNew As Workbook
     'Change Path
    Const strPath As String = "E:\Proforma Term 1 2017\"
    Dim strExtension As String
     
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error Resume Next
     
    ChDir strPath
     'Change extension
    strExtension = Dir("*.xlsm")
     
    Set wbNew = Workbooks.Add
     'Change Path, Name and File Format
    wbNew.SaveAs Filename:="E:\Proforma Term 1 2017\AllProformaC", FileFormat:=xlWorkbookNormal
     
    Do While strExtension <> ""
        Set wbOpen = Workbooks.Open(strPath & strExtension)
         
        With wbOpen
            
            .Sheets("ProformaC Term 1").Copy After:=wbNew.Sheets(wbNew.Sheets.Count)
            wbNew.Sheets(wbNew.Sheets.Count).Name = wbNew.Sheets(wbNew.Sheets.Count).Cells(5, 4)
            .Close SaveChanges:=False
        End With
         
        strExtension = Dir
    Loop
     
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    On Error GoTo 0
End Sub

However, the only thing it's doing is create the file AllProformaC. That's all. It's not copying the sheets at all.

Any help please?

Thank you.

 

[ExcelSpeedster]

I've tested your code and it works fine.

Are you sure your source files (containing the sheets you want to copy) contain the .xlsm extension? If not, they will be skipped by the above code.

 

[mystie]

Yes all the files have .xlsm extension.

Now the source workbooks all have userinterface only protection enabled in the Workbook Open event. Is that a problem?

I did add the code for unprotecting the sheets

.Sheets("ProformaC Term 1").Unprotect Password:="***"

before the line

.Sheets("ProformaC Term 1").Copy After:=wbNew.Sheets(wbNew.Sheets.Count)

But still then it didn't work.

Only the worksheets are protected, not the workbooks. If I'm not mistaken, we can copy protected sheets, right?

 

[ExcelSpeedster]

You can easily find the solution by unprotecting the source workbooks manually then trying to run the macro. If it works, you know it's the protection that's blocking the macro from working correctly.

 

[mystie]

Did that.. But still doesn't work..