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

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

Oops sorry about that. So confident I didn't run it (never learn<g).

Not really sure what you are meaning in the reference to the dropdown, but I
think you would have to unprotect, paste it in, and then re-apply
protection.

--

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
...
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