Unprotect copied protected sheets and paste a range as value

moshc

New Member
Joined
Oct 24, 2019
Messages
6
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! ?


Code:
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

Well-known Member
Joined
Jun 27, 2011
Messages
1,913
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.



Code:
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
 

Forum statistics

Threads
1,078,501
Messages
5,340,751
Members
399,393
Latest member
farlow

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...
Top