Find, Copy & Paste Values under Multiple Columns

Find, Copy & Paste Values under Multiple Columns

Below code is for copying values under "Apple" Column in sheet1 to
"AppleNew" Column in sheet2. (Thanks to Tim)
But If I have multiple columns (Orange, Banana etc) is there way to write
more simpler code that sort of go through the loop instead of having to
copy and paste code for the each columns?
Dim rng as range, rngCopy as range, rng2 as range
set rng = Sheet1.Rows(3).Find(What:="Apple", LookIn:=xlValues,
LookAt:=xlWhole)
if not rng is nothing then
set rngCopy = Sheet1.range(rng.offset(1,0), _
Sheet1.cells(rows.count,rng.column).end(xlUp))
set rng2 = Sheet2.Rows(1).Find(What:="AppleNew", LookIn:=xlValues, _
LookAt:=xlWhole)
if not rng2 is nothing then rngCopy.copy rng2.offset(1,0)
end if