G
gav meredith
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
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