protection with cells
 

Hi, i have a code that copies and pasted data based on values in a cell
however, i want this data to be protected once it is pasted to the new
worksheet. If i protect the worksheet the data is pasting to, the data will
not paste. (cells protected). How can i get around this. This is my code:


Private Sub Commandbutton2_click()
CopyData Range("E9:E94"), "OPTIONS"
End Sub
Private Sub CopyData2(rngE As Range, Target As String)
Dim rng As Range, cell As Range
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range
Dim nrow As Long, rw As Long
Dim sh As Worksheet
nrow = Application.CountIf(rngE, "0")
If nrow = 0 Then Exit Sub
Set sh = Worksheets("Quote2")
Set rng = sh.Columns(1).Find(What:=Target, _
After:=sh.Range("A1"), _
LookIn:=xlFormulas, _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
' Set rng1 = sh.Columns(1).FindNext(rng)
' Set rng3 = sh.Range(rng, rng1)
Set rng3 = rng
rng.Offset(1, 0).ClearContents
If Application.CountA(rng3) 2 Then
' Set rng3 = rng1.End(xlUp).Offset(2, 0)
Else
Set rng3 = rng.Offset(2, 0)
End If
rw = rng3.Row
rng3.Resize(nrow * 2, 1).EntireRow.Insert
For Each cell In rngE
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Range("A9,B9").Copy _
Destination:=sh.Cells(rw, 1)
rw = rw + 2
End If
End If
End If
Next
End Sub

protection with cells
 

Unprotect the sheet before you start copying/pasting and protect it when
you're through. Use the following code. HTH Otto

Sheets("SheetName").Protect Password:="rob1"

Sheets("SheetName").Unprotect Password:="rob1"

"gav meredith" wrote in message
...
Hi, i have a code that copies and pasted data based on values in a cell
however, i want this data to be protected once it is pasted to the new
worksheet. If i protect the worksheet the data is pasting to, the data
will
not paste. (cells protected). How can i get around this. This is my code:


Private Sub Commandbutton2_click()
CopyData Range("E9:E94"), "OPTIONS"
End Sub
Private Sub CopyData2(rngE As Range, Target As String)
Dim rng As Range, cell As Range
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range
Dim nrow As Long, rw As Long
Dim sh As Worksheet
nrow = Application.CountIf(rngE, "0")
If nrow = 0 Then Exit Sub
Set sh = Worksheets("Quote2")
Set rng = sh.Columns(1).Find(What:=Target, _
After:=sh.Range("A1"), _
LookIn:=xlFormulas, _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
' Set rng1 = sh.Columns(1).FindNext(rng)
' Set rng3 = sh.Range(rng, rng1)
Set rng3 = rng
rng.Offset(1, 0).ClearContents
If Application.CountA(rng3) 2 Then
' Set rng3 = rng1.End(xlUp).Offset(2, 0)
Else
Set rng3 = rng.Offset(2, 0)
End If
rw = rng3.Row
rng3.Resize(nrow * 2, 1).EntireRow.Insert
For Each cell In rngE
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Range("A9,B9").Copy _
Destination:=sh.Cells(rw, 1)
rw = rw + 2
End If
End If
End If
Next
End Sub

protection with cells
 

where within the code would i place this??
"Otto Moehrbach" wrote in message
...
Unprotect the sheet before you start copying/pasting and protect it when
you're through. Use the following code. HTH Otto

Sheets("SheetName").Protect Password:="rob1"

Sheets("SheetName").Unprotect Password:="rob1"

"gav meredith" wrote in message
...
Hi, i have a code that copies and pasted data based on values in a cell
however, i want this data to be protected once it is pasted to the new
worksheet. If i protect the worksheet the data is pasting to, the data
will
not paste. (cells protected). How can i get around this. This is my
code:


Private Sub Commandbutton2_click()
CopyData Range("E9:E94"), "OPTIONS"
End Sub
Private Sub CopyData2(rngE As Range, Target As String)
Dim rng As Range, cell As Range
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range
Dim nrow As Long, rw As Long
Dim sh As Worksheet
nrow = Application.CountIf(rngE, "0")
If nrow = 0 Then Exit Sub
Set sh = Worksheets("Quote2")
Set rng = sh.Columns(1).Find(What:=Target, _
After:=sh.Range("A1"), _
LookIn:=xlFormulas, _
Lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
' Set rng1 = sh.Columns(1).FindNext(rng)
' Set rng3 = sh.Range(rng, rng1)
Set rng3 = rng
rng.Offset(1, 0).ClearContents
If Application.CountA(rng3) 2 Then
' Set rng3 = rng1.End(xlUp).Offset(2, 0)
Else
Set rng3 = rng.Offset(2, 0)
End If
rw = rng3.Row
rng3.Resize(nrow * 2, 1).EntireRow.Insert
For Each cell In rngE
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Range("A9,B9").Copy _
Destination:=sh.Cells(rw, 1)
rw = rw + 2
End If
End If
End If
Next
End Sub