Unprotect copied protected sheets and paste a range as value

[moshc]

Hi All I have this code below,

I'm trying to figure out how i can copy protected sheets and unprotect together with copying a specific range and pasting it as value only.

Hoping for a quick response. Thank you! ?

Sub CopySheets()    Application.ScreenUpdating = False
    Dim MyFolder As String, MyFile As String, srcWB As Workbook, desWB As Workbook
    Set desWB = ThisWorkbook
    
    On Error Resume Next
    ActiveWorkbook.Unprotect Password:="sky1212"
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then
            MsgBox "You did not select a folder."
            Exit Sub
        End If
        MyFolder = .SelectedItems(1) & "\"
    End With
    MyFile = Dir(MyFolder)
    Do While MyFile <> ""
        Set srcWB = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
        With srcWB
            .Sheets(1).Copy desWB.Sheets(desWB.Sheets.Count)
            With ActiveSheet.UsedRange
                .Cells.Validation.Delete
                .Cells.Value = .Cells.Value
            End With
            .Close False
        End With
        MyFile = Dir
    Loop
    Application.ScreenUpdating = True
Worksheets("Sheet1").Visible = xlSheetHidden
End Sub

 

[gallen]

Hello. Missing a little info but I think I understand.

To just use the 'Unprotect' method ensuring to include a password if it needs it
To paste values you need to use PasteSpecial as below
This should point you in the right direction.

Sub CopySheets()
Application.ScreenUpdating = False
    Dim MyFolder As String, MyFile As String, srcWB As Workbook, desWB As Workbook
    Set desWB = ThisWorkbook
    
    On Error Resume Next
    ActiveWorkbook.Unprotect Password:="sky1212"
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then
            MsgBox "You did not select a folder."
            Exit Sub
        End If
        MyFolder = .SelectedItems(1) & "\"
    End With
    MyFile = Dir(MyFolder)
    Do While MyFile <> ""
        Set srcWB = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
        With srcWB
            .Sheets(1).Unprotect "password"
            .Sheets(1).Cells.Copy 'copy all the cells.
            desWB.Sheets(desWB.Sheets.Count).Cells(1, 1).PasteSpecialxlPasteValues 'only paste values starting at A1
            With ActiveSheet.UsedRange
                .Cells.Validation.Delete
                .Cells.Value = .Cells.Value
            End With
            .Sheets(1).Protect "password"
            .Close False
        End With
        MyFile = Dir
    Loop
    Application.ScreenUpdating = True
Worksheets("Sheet1").Visible = xlSheetHidden
End Sub