View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
CaptainQuattro[_4_] CaptainQuattro[_4_] is offline
external usenet poster
 
Posts: 1
Default 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