ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   how to copy and paste in a protected worksheet (https://www.excelbanter.com/excel-programming/370257-re-how-copy-paste-protected-worksheet.html)

CaptainQuattro[_4_]

how to copy and paste in a protected worksheet
 

I have written the following macro that copies from all the unprotected
cells in the active cell row and pastes to the corresponding cells in
another row.

The benefit of doing this as opposed to simply unlocking the
destination range, pasting and locking it again is that there is no
guarantee that the locked cells in the destination range are blank or
contain exact copies of the formulas in the source range.

DISCLAIMER/WARNING:

THIS IS BRAND NEW CODE, SO PLEASE USE EXTREME CAUTION, AND MAKE
MULTIPLE BACKUPS OF YOUR FILE BEFORE YOU START TO TEST.

Option Explicit
Sub CopyUnlocked()

Dim DestRow As Integer

DestRow = Application.InputBox(Prompt:="Enter Destination Row",
Title:="DestinationRow", Type:=1)
Dim c As Range
Dim DestRange As Range
Dim rng As Range


Range("$A$" & ActiveCell.Row).Select
Set c = ActiveCell

If (c.Locked) Then
Do Until Not (c.Locked)

If c.Column = 256 Then
Exit Do
End If

Set c = c.Offset(0, 1)
Loop
End If




Do While c.Column < 257

If (c.Locked) Then
Do Until Not (c.Locked)
If c.Column = 256 Then
Exit Do
End If
Set c = c.Offset(0, 1)
Loop
End If

Set rng = c
Set DestRange = c.Offset(DestRow - c.Row, 0)

Do Until (c.Locked)

Set c = c.Offset(0, 1)

If (c.Locked) Then
Exit Do ' Exit the do until loop
End If


Set rng = Union(rng, c)

If c.Column = 256 Then
Exit Do ' exit the do until loop
End If


Loop


rng.Copy
DestRange.PasteSpecial xlPasteValues
Range("$A$" & DestRange.Row).Select

If c.Column = 256 Then
Exit Do ' exit the do WHILE loop
End If

Set c = c.Offset(0, 1)
Set rng = c
Set DestRange = c.Offset(DestRow - c.Row, 0)


Loop
End Sub


--
CaptainQuattro
------------------------------------------------------------------------
CaptainQuattro's Profile: http://www.excelforum.com/member.php...o&userid=32763
View this thread: http://www.excelforum.com/showthread...hreadid=571191


CaptainQuattro[_5_]

how to copy and paste in a protected worksheet
 

George:

I tested the macro by

copying the code back from my posting to a new workbook (Just in case
something got messed up in the process of posting it.)

Unlocking column A
Unlocking column C through IV
Protecting the worksheet
Saving the workbook, closing and re-loading it.

It worked for me under these conditions.

If anyone has any ideas to improve this macro, please feel free to dive
in.

Regards.


--
CaptainQuattro
------------------------------------------------------------------------
CaptainQuattro's Profile: http://www.excelforum.com/member.php...o&userid=32763
View this thread: http://www.excelforum.com/showthread...hreadid=571191


CaptainQuattro[_6_]

how to copy and paste in a protected worksheet
 

Ok George, I think I've got it.

Martin Rice was right that you need a macro that unlocks and re-locks
the sheet.


I have written 2 new macros: One for copying and pasting within the
same worksheet, and the other for copying from an external worksheet to
the current sheet.

It occurred to me that there is a danger of accidentally pasting over a
row of good data, therefore I have included the following protection:

Column IV can be unlocked.
On each row of good data, column IV should contain the letter "P"
(uppercase). The macros will not paste onto a row that contains this
flag in column IV. If the user needs to override this feature, he or
she can do so by clearing the 'P' on that row.

If you don't want to trust the users, you can leave column IV locked so
that the users have to call you to unprotect the worksheet and clear the
P.

Because the code includes the password to unprotect the sheet, you
should paste the code into a button from the Control toolbox toolbar,
not from the Forms toolbar. When the sheet is protected it will not be
possible for users to right click the button and see the code.

After creating the buttons, click on each one's properties and change
the names to CopyRow and CopyExternalRow.

Option Explicit

Private Sub CopyExternalRow_Click()
ActiveSheet.Protect Password:="captain"
On Error GoTo errhandle

Dim iSourceRow As Integer
Dim iDestRow As Integer
Dim sDestRow As String
Dim sSourceRow As String
Dim sSourceBook As String

Dim sSourceSheet As String
Dim sDestBook As String

sDestBook = ThisWorkbook.Name
sSourceBook = Application.InputBox(Prompt:="Enter Workbook to copy
from" & Chr$(13) & "do not include file extension (e.g. .xls)",
Title:="SourceBook", Type:=2) & ".xls"
sSourceSheet = Application.InputBox(Prompt:="Enter Sheet to copy
from", Title:="SourceSheet", Type:=2)
iSourceRow = Application.InputBox(Prompt:="Enter Row to copy from",
Title:="SourceRow", Type:=1)
sSourceRow = "$" & iSourceRow & ":$" & iSourceRow
iDestRow = Application.InputBox(Prompt:="Enter Destination Row",
Title:="DestinationRow", Type:=1)
sDestRow = "$" & iDestRow & ":$" & iDestRow


'To prevent accidentally overwriting existing data, column IV of
the worksheet should be unprotected
'and you should enter the letter P in column IV of each row that
you want to protect. The macro will
'automatically enter a 'P' in column IV of your destination row.

If Range("IV" & iDestRow).Value = "P" Then
MsgBox "Row " & iDestRow & " is marked as protected." & Chr$(13) &
"Clear cell IV" & iDestRow & " to overwrite contents of row " &
iDestRow
End

Else
End If



ActiveSheet.Unprotect Password:="captain"
Windows(sSourceBook).Activate
ActiveWorkbook.Sheets(sSourceSheet).Range(sSourceR ow).Copy
Windows(sDestBook).Activate


Range(sDestRow).PasteSpecial xlPasteAll
Range("IV" & iDestRow).Value = "P"

errhandle:
ActiveSheet.Protect Password:="captain"

End Sub


Private Sub CopyRow_Click()
ActiveSheet.Protect Password:="captain"
On Error GoTo errhandle

Dim iDestRow As Integer
Dim sDestRow As String
Dim sSourceRow As String


sSourceRow = "$" & ActiveCell.Row & ":$" & ActiveCell.Row
iDestRow = Application.InputBox(Prompt:="Enter Destination Row",
Title:="DestinationRow", Type:=1)

'To prevent accidentally overwriting existing data, column IV of
the worksheet should be unprotected
'and you should enter the letter P in column IV of each row that
you want to protect. The macro will
'automatically enter a 'P' in column IV of your destination row.

If Range("IV" & iDestRow).Value = "P" Then
MsgBox "Row " & iDestRow & " is marked as protected." & Chr$(13) &
"Clear cell IV" & iDestRow & " to overwrite contents of row " &
iDestRow
End

Else
End If

sDestRow = "$" & iDestRow & ":$" & iDestRow

ActiveSheet.Unprotect Password:="captain"

Range(sSourceRow).Copy
Range(sDestRow).PasteSpecial xlPasteAll
Range("IV" & iDestRow).Value = "P"

errhandle:
ActiveSheet.Protect Password:="captain"

End Sub


--
CaptainQuattro
------------------------------------------------------------------------
CaptainQuattro's Profile: http://www.excelforum.com/member.php...o&userid=32763
View this thread: http://www.excelforum.com/showthread...hreadid=571191


CaptainQuattro[_7_]

how to copy and paste in a protected worksheet
 

George:

I will send you a copy of my working model.

But it sounds as if the following would work better for you:

Have a separate, completely unprotected sheet for user input and a
fully protected sheet that uses formulas to reflect what the user has
input.

If you use =OFFSET formulas on your protected sheet, the users will be
free to insert and delete rows and columns on the input sheet at will
without corrupting the protected sheet.

For example, enter the following formula in cell A1 of Sheet1:

=OFFSET(Sheet2!$A$1,ROWS($A$1:D3)-1,COLUMNS($A$1:D3)-1)

and copy this formula to the range A1:H20000

Enter whatever other formulas you need in columns I through IV

Use Tools Options View and un-check Zero values.

Protect Sheet1 with password.

Hope this helps.


--
CaptainQuattro
------------------------------------------------------------------------
CaptainQuattro's Profile: http://www.excelforum.com/member.php...o&userid=32763
View this thread: http://www.excelforum.com/showthread...hreadid=571191



All times are GMT +1. The time now is 12:29 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com