查找某些文本，复制并粘贴到新工作表中

Question

I have this code here that goes through my sheet column C and and find all the cells with "Geoff" in it and copies it and pastes it in "Geoff" sheet from active sheet. what I need it to accomplish is copying the whole row and pasting it into "Geoff" sheet.

Dim K As Long, r As Range, v As Variant
K = 1
Dim w1 As Worksheet, w2 As Worksheet
Set w1 = Sheets("Active")
Set w2 = Sheets("Geoff")
w1.Activate
For Each r In Intersect(Range("C:C"), ActiveSheet.UsedRange)
    v = r.Value
    If InStr(v, "Geoff") > 0 Then
        r.Copy w2.Cells(K, 1)
        K = K + 1
    End If
Next r

it only copies Geoff from Column CI need it to copy the entire row. Any help or ideas?

Answer 1

r.EntireRow.Copy w2.Cells(K, 1)

should work

Or if you want to be more selective:

r.EntireRow.Cells(1).Resize(1, numColsToCopy).Copy w2.Cells(K, 1)