copy entire row, not just cell in row

[Guest]

I've tried adapting code to accomplish copy and pasting from the Sheet "All
Records" to a new Sheet called "Short Names" all rows with 3 characters or
less in the last name of the Name Column which is column D in the All Records
Table. The name format is last name, then a comma, then a space and then the
first name. For Example

Fox, James or Ray, Barbara.

These sheets are part of hte same workbook. I appreciate any help you can
provide. Thanks

Dim rng As Range, cell As Range

Dim i As Long, sh As Worksheet
With Worksheets("All Records")
Set rng = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
i = 1

Set sh = Worksheets("Short Names")
For Each cell In rng

With sh
Set rng = .Range(.Cells(2, "D"), .Cells(Rows.Count, "D").End(xlUp))
End With


s = Replace(Trim(cell.Value), " ", "")
ipos = InStr(1, s, ",", vbTextCompare)
If ipos <= 4 And ipos <> 0 Then
s1 = Left(s, ipos - 1)
sh1.Cells(rw, 1).Value = s1
rw = rw + 1
End If
Next

End Sub

 

[Tom Ogilvy]

I answered you in the original thread.