Copy all named ranges but first unprotecting all sheets

[howard]

I have a macro that first unprotects all sheets from sheet3 and the copies the named range that match the sheet with the same name as the ranged sheet and then protects the sheet

I am battling to get this to work,

It would be appreciated if someone could assist me

 Sub Copy_Comm()
Application.DisplayAlerts = False

Dim i As Long
For i = 3 To Worksheets.Count


     
       Worksheets(i).Unprotect
      
    Next i
    

With Sheets(1)
    .Range("Peter).Copy
    
        Sheets("Peter).Range("A1").PasteSpecial Paste:=xlPasteValues
        End With
        
     Worksheets(i).Protect
   Next i
    

 End Sub

 

[antialias401]

It depends on how you want to Paste:
If you want to paste keeping formats AND pasting values only:

.PasteSpecial Paste:=xlPasteFormats, Paste:=xlPasteValues

Or if you want to paste keeping formats and formulas intact:

.PasteSpecial Paste:=xlPasteFormats

 

[howard]

Thanks very much

 

[howard]

I need a bit more help.

I have added some code at the end to hide specific columns but get an error message "Subscript out of range" and the code With Worksheets(i) is highlighted

It would be appreciated if you could assist me

 Sub Copy_All_Comms()

Clear_Sheets
 Dim i As Integer, LastRow As Long
        
        'Loop Through Worksheets
        For i = 3 To Worksheets.Count
        
        'Unprotect Worksheet
        Worksheets(i).Unprotect
    
            'Find the last row in Column A in Sheet Neil_PE
            LastRow = Sheets("Peter").Cells(Sheets("Peter").Rows.Count, "A").End(xlUp).Row

            'Work with The Current Unprotected Sheet:
            With Worksheets(i)
                'Use The Worksheet Name to Return The Named Range
                Range(Worksheets(i).Name).Copy
                'Use The Worksheet Name to Copy The Above Named Range Into The Worksheet by the SAME NAME
                Worksheets(i).Range("A1:A" & LastRow).Offset(1).PasteSpecial Paste:=xlPasteValues
            End With
             Columns("C:C").ColumnWidth = 11
        'ReProtect WorkSheet
        Worksheets(i).protect
        Next i
        Sheets(2).Unprotect
         With Worksheets(i)
        .Range("D:D", "F:F", "H:H", "L:L").EntireColumn.Hidden = True
        End With
        
End Sub

 

[antialias401]

According to your code, you want to hide columns D,F,H, & L, but only in sheet 2
IF that is the case, replace your added code with this:

       'Work With Sheet 2 Only:
    With Sheets(2)
        .Unprotect
       'Hide Columns D,F,H,&L
        .Range("D:D").EntireColumn.Hidden = True
        .Range("F:F").EntireColumn.Hidden = True
        .Range("H:H").EntireColumn.Hidden = True
        .Range("L:L").EntireColumn.Hidden = True
       'ReProtect The Sheet
        .Protect
    End With

Regards

 

[howard]

Thanks for your code, much appreciated

Sorry I meant on all sheets except sheet 1 & 2

See my code below , which I amended and which works

 Sub Copy_All_Comms()

Clear_Sheets
 Dim i As Integer, LastRow As Long
        
        'Loop Through Worksheets
        For i = 3 To Worksheets.Count
        
        'Unprotect Worksheet
        Worksheets(i).Unprotect
    
            'Find the last row in Column A in Sheet Neil_PE
            LastRow = Sheets("Comm_PE").Cells(Sheets("Comm_PE").Rows.Count, "A").End(xlUp).Row

            'Work with The Current Unprotected Sheet:
            With Worksheets(i)
                'Use The Worksheet Name to Return The Named Range
                Range(Worksheets(i).Name).Copy
                'Use The Worksheet Name to Copy The Above Named Range Into The Worksheet by the SAME NAME
                Worksheets(i).Range("A1:A" & LastRow).Offset(1).PasteSpecial Paste:=xlPasteValues
            End With
             Columns("C:C").ColumnWidth = 11
        'ReProtect WorkSheet
        Worksheets(i).protect
       
        Worksheets(i).Unprotect
       'Hide Columns D,F,H,&L
        Range("D:D").EntireColumn.Hidden = True
        Range("F:F").EntireColumn.Hidden = True
        Range("H:H").EntireColumn.Hidden = True
        Range("L:L").EntireColumn.Hidden = True
       'ReProtect The Sheet
       Worksheets(i).protect
     Next i
        
End Sub

 

[antialias401]

No problem Howard, glad I could help.

Hmmm, but do I detect a potential problem in the final code?
This copies the Named Range of the Matching Worksheet.
Then it pastes that named range, Into the Worksheet that has the same name.

The potential problem is that "LastRow" is being calculated on sheet Comm_PE, and using that count in each worksheet in the loop.
If this is what you want, then that is perfectly OK, just make sure it is what you want.

Regards

 

[howard]

Thanks for the reply. Thank goodness all the named ranges contain the same number of rows

If they were different, would I change the code as follows where Comm_Br15 is the last range to be copied?

LastRow = Sheets("Comm_PE").Cells(Sheets("Comm_Br15").Rows.Count, "A").End(xlUp).Row

 

[antialias401]

You would change it to this instead:

LastRow = Worksheets(i).Cells(Worksheets(i).Rows.Count, "A").End(xlUp).Row

There were a few issues with the code that I cleaned up...

1st, if the row size ever did change, you would have received an error due to size mismatch.
2nd the copied data was overwriting any existing data, but only for the current row size, which would also cause headaches if the row size ever changed.
3rd removed redundant protecting/unprotecting of current worksheet

I put in a Msgbox to reflect the above changes; comment it out once you are sure your code is working the way it is supposed to.

Tested:

 Sub Copy_All_Comms()

    'Clear_Sheets
    Dim i As Integer, LastRow As Long
        
    'Loop Through Worksheets
    For i = 3 To Worksheets.Count
    
        'Unprotect Worksheet
        Worksheets(i).Unprotect
        
            'Find the last row in Column A in Current WorkSheet
            LastRow = Worksheets(i).Cells(Worksheets(i).Rows.Count, "A").End(xlUp).Row
            
            'Comment this next line out, It is only for Debugging
            If LastRow > 1 Then MsgBox """" & Worksheets(i).Name & """ has " & LastRow & " rows of data. Copied data will be appended starting at row " & LastRow + 1
 
            'Use The Worksheet Name to Return The Named Range
            Range(Worksheets(i).Name).Copy
            
            'In Worksheet(i), Copy The Above Named Range Into First Unused Cell
            Worksheets(i).Range("A" & LastRow).Offset(1).PasteSpecial Paste:=xlPasteValues
            
                       
            'Work with The Current Unprotected Sheet:
            With Worksheets(i)
                'Hide Columns D,F,H,&L
                .Range("D:D").EntireColumn.Hidden = True
                .Range("F:F").EntireColumn.Hidden = True
                .Range("H:H").EntireColumn.Hidden = True
                .Range("L:L").EntireColumn.Hidden = True
                'Resize Column C
                .Columns("C:C").ColumnWidth = 11
            End With
            
        'ReProtect The Sheet
        Worksheets(i).Protect
    Next i
        
End Sub

Regards

 

[howard]

Thanks very much for the update. This is most appreciated

 

[antialias401]

Thanks very much for the update. This is most appreciated

Glad it worked it out for you Howard