text inclusion

[GeoffM]

Can someone please amend this so that copy/paste occurs if column D > 1 AND column E contains text 'inc'

Thank you

Private Sub CommandButton1_Click(
CopyData Range("D913"), "FEEDER
CopyData Range("D1658"), "MACHINE
CopyData Range("D6373"), "DELIVERY
CopyData Range("D7882"), "PECOM
CopyData Range("D8894"), "ROLLERS
CopyData Range("D104128"), "MISCELLANEOUS
End Su
Private Sub CopyData(rngD As Range, Target As String
Dim rng As Range, cell As Rang
Dim rng1 As Range, rng2 As Rang
Dim rng3 As Rang
Dim nrow As Long, rw As Lon
Dim Sh As Workshee
nrow = Application.CountIf(rngD, ">0"
If nrow = 0 Then Exit Su
Set Sh = Worksheets("Quote2"
Set rng = Sh.Columns(1).Find(What:=Target,
After:=Sh.Range("A1"),
LookIn:=xlValues,
LookAt:=xlPart,
SearchOrder:=xlByRows,
SearchDirection:=xlNext,
MatchCase:=False
Set rng3 = rn
rng.Offset(1, 0).ClearContent
If Application.CountA(rng3) > 2 The
Els
Set rng3 = rng.Offset(2, 0
End I
rw = rng3.Ro
rng3.Resize(nrow * 2, 1).EntireRow.Inser
For Each cell In rng
If Not IsEmpty(cell) The
If IsNumeric(cell) The
If cell > 0 The
Cells(cell.Row, 1).Resize(1, 2).Copy
Destination:=Sh.Cells(rw, 1
rw = rw +
End I
End I
End I
Nex
End Su