Allow to edit specific columns after pasting values form another sheet

justme101

New Member
Joined
Nov 18, 2017
Messages
34
Hello All,

I am copying cells from a sheet titled "Data" to another sheet called "Status Update". The user will have the flexibility to edit only ranges in two columns, L & M, and others will be locked. I have the code to copy the cells and paste it but the allow edit ranges part gives the run time 1004: Application defined or object-defined error. The code i use is given below. Any help is appreciated.

ActiveWorkbook.Worksheets("Status Update").Unprotect "12345"
ActiveSheet.Cells.Locked = False

Set sh = Sheets("Data")

sh.Range("M1:M" & sh.Cells(sh.Rows.Count, 1).End(xlUp).Row).AutoFilter 1, "WIP"
With Worksheets("Data").AutoFilter.Range
Range("A" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With
sh.Range("A2:A" & sh.Cells(sh.Rows.Count, 1).End(xlUp).Row).EntireRow.SpecialCells(xlCellTypeVisible).Copy

ActiveWorkbook.Worksheets("WIP Tracker").Range("A3").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("WIP Tracker").Range("A3").PasteSpecial xlPasteFormats

Application.CutCopyMode = False

Sheets("Status Update").Columns("L:M").Select
Sheets("Status Update").Protection.AllowEditRanges.Add Title:="Range1", Range:=Columns( _
"L:M")

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
If you only have the one edit range on that sheet try
VBA Code:
Sheets("Status Update").Select
With Sheets("Status Update").Protection.AllowEditRanges
   If .Count > 0 Then
      .Item("Range1").Delete
   End If
   .Add Title:="Range1", Range:=Columns("L:M")
End With
 

justme101

New Member
Joined
Nov 18, 2017
Messages
34
If you only have the one edit range on that sheet try
VBA Code:
Sheets("Status Update").Select
With Sheets("Status Update").Protection.AllowEditRanges
   If .Count > 0 Then
      .Item("Range1").Delete
   End If
   .Add Title:="Range1", Range:=Columns("L:M")
End With
Thank Fluff! This works. Just to add to my query. How to add columns to this code, if they are not next to each other. For e.g. if the ranges I want to be edited are Columns D, L & M?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
   .Add Title:="Range1", Range:=Range("D:D,L:M")
 

justme101

New Member
Joined
Nov 18, 2017
Messages
34

ADVERTISEMENT

OK, I don't
How about
VBA Code:
   .Add Title:="Range1", Range:=Range("D:D,L:M")
OK, I don't know what is going on, but your original reply worked the first time I tested it, but it is not working now. I have not even added your next suggestion for column D. Is it something to do with range names? I don't know what to do. The current code is this:

VBA Code:
ActiveWorkbook.Worksheets("Status Update").Unprotect "12345"
ActiveSheet.Cells.Locked = False

Set sh = Sheets("Data")

sh.Range("M1:M" & sh.Cells(sh.Rows.Count, 1).End(xlUp).Row).AutoFilter 1, "WIP"
With Worksheets("Data").AutoFilter.Range
Range("A" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Select
End With
sh.Range("A2:A" & sh.Cells(sh.Rows.Count, 1).End(xlUp).Row).EntireRow.SpecialCells(xlCellTypeVisible).Copy

ActiveWorkbook.Worksheets("Status Update").Range("A3").PasteSpecial xlPasteValues
ActiveWorkbook.Worksheets("Status Update").Range("A3").PasteSpecial xlPasteFormats

Application.CutCopyMode = False

Sheets("Status Update").Select
With Sheets("Status Update").Protection.AllowEditRanges
   If .Count > 0 Then
      .Item("Range1").Delete
   End If
   .Add Title:="Range1", Range:=Columns("L:M")
End With

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
   
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
What is the error number & message & what line is highlighted?
 

justme101

New Member
Joined
Nov 18, 2017
Messages
34

ADVERTISEMENT

N
What is the error number & message & what line is highlighted?
No error, it just copy pastes the cells according to the filter, but does not lock anything. I am able to edit every cell in the pasted data.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
That's because you are unlocking all the cells with this line (assuming the staus update sheet is active)
VBA Code:
ActiveSheet.Cells.Locked = False
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
As you have already unlocked all the cells, you will need to relock those that shouldn't be touched.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,685
Messages
5,637,808
Members
416,983
Latest member
LessThanAverageUser

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top