VBA code needing alteration

[gavmer]

I am a novice with VBA and require alteration to this code, if possible
What i have now is the first 3 rows copying across. What i would lik
is to have selected cells in the row copy. ie: a1, a2 and a4. Is thi
possible?? Thank you

Private Sub Commandbutton1_click()
CopyData Range("E90:E100"), "MODEL"
CopyData Range("E105:E113"), "UV CURING"
CopyData Range("E118:E134"), "TRANSFORMER"
End Sub
Private Sub CopyData(rngC 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(rngC, ">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).Resize(1, 3).Copy _
Destination:=sh.Cells(rw, 1)
rw = rw + 2
End If
End If
End If
Next
End Sub



Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

End Su