View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
gav meredith gav meredith is offline
external usenet poster
 
Posts: 54
Default Copy text only

Thanks bob, that worked. Just swapped the pastespecial and paste round.
Thanks again. Q: is there a way can protect the information that I have
copied across?? If I protect the cells, it wont allow pasting. The
information is selected via a dropdown list and I cant protect the cells is
references (or can i???)

Cells(cell.Row, 1).Range("A9,B9").Copy

sh.Cells(rw, 1).PasteSpecial Paste:=xlPasteValues

"Bob Phillips" wrote in message
...
Hi Gav,

Not sure I have got it all but change these lines

Cells(cell.Row, 1).Range("A9,B9").Copy _
Destination:=sh.Cells(rw, 1)

To

Cells(cell.Row, 1).Range("A9,B9").Copy
sh.Cells(rw, 1).Paste PasteSpecial:=xlPasteValues

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"gav meredith" wrote in message
...
hi again, another question. With the following code, i would like only

the
text within a cell to copy. At the moment, the cell being copied has a

white
background but is pasting to a sheet with a grey background. I would

like
the background to remain grey and not copy to white as it does. Any
suggestions???????? Thank you!!!


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