Hi There,

Is is possible to copy the locked status of a cell?

Situation:
- I have a cell locked
- I have my sheet protected
- I run a macro to copy the locked cell and pasting it afterwards

= The pasted cell does not inherit the locked status!

Is it possible to inherit this status as well?
Or is the way to go: Unlock sheet ...copy ..paste ..lock again?


I am sure Bob Phillips will recognise some of the code ;o)))

Sub Check_Usedrange()
Dim lngLastRow As Long, lngLastCol As Long, j As Long
On Error Resume Next
lngLastRow = 1
With ActiveSheet.UsedRange
lngLastRow = .Find("*", .Cells(1), xlFormulas, xlWhole,
xlByRows, xlPrevious).Row
.Rows(lngLastRow).Copy
.Rows(lngLastRow + 1).PasteSpecial Paste:=xlPasteFormats
.Rows(lngLastRow + 1).PasteSpecial Paste:=xlPasteFormulas

For j = 1 To .Cells(lngLastRow + 1,
Columns.Count).End(xlToLeft).Column
If Not .Cells(lngLastRow + 1, j).HasFormula Then
.Cells(lngLastRow + 1, j).ClearContents
End If
Next j
End With
End Sub

Thanks for assisting once again,
Sige

One line of code added:

Sub Check_Usedrange()
Dim lngLastRow As Long, lngLastCol As Long, j As Long
On Error Resume Next
lngLastRow = 1
With ActiveSheet.UsedRange
lngLastRow = .Find("*", .Cells(1), xlFormulas, xlWhole _
, xlByRows, xlPrevious).Row
.Rows(lngLastRow).Copy
.Rows(lngLastRow + 1).PasteSpecial Paste:=xlPasteFormats
.Rows(lngLastRow + 1).PasteSpecial Paste:=xlPasteFormulas

For j = 1 To .Cells(lngLastRow + 1, Columns.Count). _
End(xlToLeft).Column
.Cells(lngLastRow + 1, j).Locked = _
.Cells(lngLastRow, j).Locked
If Not .Cells(lngLastRow + 1, j).HasFormula Then
.Cells(lngLastRow + 1, j).ClearContents
End If
Next j
End With
End Sub

Hope this helps
Rowan

Sige wrote:
Hi There,

Is is possible to copy the locked status of a cell?

Situation:
- I have a cell locked
- I have my sheet protected
- I run a macro to copy the locked cell and pasting it afterwards

= The pasted cell does not inherit the locked status!

Is it possible to inherit this status as well?
Or is the way to go: Unlock sheet ...copy ..paste ..lock again?


I am sure Bob Phillips will recognise some of the code ;o)))

Sub Check_Usedrange()
Dim lngLastRow As Long, lngLastCol As Long, j As Long
On Error Resume Next
lngLastRow = 1
With ActiveSheet.UsedRange
lngLastRow = .Find("*", .Cells(1), xlFormulas, xlWhole,
xlByRows, xlPrevious).Row
.Rows(lngLastRow).Copy
.Rows(lngLastRow + 1).PasteSpecial Paste:=xlPasteFormats
.Rows(lngLastRow + 1).PasteSpecial Paste:=xlPasteFormulas

For j = 1 To .Cells(lngLastRow + 1,
Columns.Count).End(xlToLeft).Column
If Not .Cells(lngLastRow + 1, j).HasFormula Then
.Cells(lngLastRow + 1, j).ClearContents
End If
Next j
End With
End Sub

Thanks for assisting once again,
Sige

Hi Rowan,

Thanks... but the locked cell status does not get inherited!
Sige

Hi Sige,

Your original code *will* copy the locked cell status. providing that you
set the Protect method;s UserInterfaceOnly argument to True.

Setting the Protect method's UserInterfaceOnly parameter to true enables VBA
manipulation of the protected sheet.

However, this setting is not persistent and needs to be reset each time the
workbook is opened.

Perhaps, therefore, you could set protection in the Workbook_Open or
Auto_Open procedures, e.g.:

'================
Sub Workbook_Open()
With ActiveSheet
.Protect Password:="SIGE", UserInterfaceOnly:=True
End With
End Sub

'<<================

This code should be pasted into the workbook's ThisWorkbook module - not a
standard module.


---
Regards,
Norman



"Sige" wrote in message
oups.com...
Hi Rowan,

Thanks... but the locked cell status does not get inherited!
Sige

Hip Hip ... the magic trick!
Thx Norman

I'd unprotect, do the work and reprotect.

The "lockedness" didn't get carried over for me, either (xl2003).

Sige wrote:

Hi There,

Is is possible to copy the locked status of a cell?

Situation:
- I have a cell locked
- I have my sheet protected
- I run a macro to copy the locked cell and pasting it afterwards

= The pasted cell does not inherit the locked status!

Is it possible to inherit this status as well?
Or is the way to go: Unlock sheet ...copy ..paste ..lock again?

I am sure Bob Phillips will recognise some of the code ;o)))

Sub Check_Usedrange()
Dim lngLastRow As Long, lngLastCol As Long, j As Long
On Error Resume Next
lngLastRow = 1
With ActiveSheet.UsedRange
lngLastRow = .Find("*", .Cells(1), xlFormulas, xlWhole,
xlByRows, xlPrevious).Row
.Rows(lngLastRow).Copy
.Rows(lngLastRow + 1).PasteSpecial Paste:=xlPasteFormats
.Rows(lngLastRow + 1).PasteSpecial Paste:=xlPasteFormulas

For j = 1 To .Cells(lngLastRow + 1,
Columns.Count).End(xlToLeft).Column
If Not .Cells(lngLastRow + 1, j).HasFormula Then
.Cells(lngLastRow + 1, j).ClearContents
End If
Next j
End With
End Sub

Thanks for assisting once again,
Sige

--

Dave Peterson

Hi Dave,

I suspected it to be the only way ... but Norman's way does what I
hoped it would!

Sige