Well, after some additional troubleshooting, I've observed that this won't catch those instances of "4101" in records if they don't exist at least on the first line. The original code is below, with my changes to sheets... the instances may be in every row, or in one row - it varies. If this code will catch that, what have I modified incorrectly?
Thanks...
' The sheet with the source data
Private Const Sheet1 As Byte = 1
' The sheet to which data will be
' pasted
Private Const Sheet2 As Byte = 2
Sub CutStuff()
Dim InitialRow As Long
Dim InitialCol As Long
Dim FinalRow As Long
Dim FinalCol As Long
' The first row you want to search
InitialRow = 1
' The first column you want to search
InitialCol = 1
' The last column you want to search
FinalCol = 30
Dim s As String
' If always searching for the same
' pattern, consider changing the next
' line to s = "pattern"
s = "4101"
Dim FoundCell As Range
Dim RowsCut As Long
Dim BlankRow As Long
Do
Sheets("Sheet1"

.Activate
FinalRow = Range(Cells(65536, FinalCol), _
Cells(65536, FinalCol)).End(xlUp).Row
Range(Cells(InitialRow, InitialCol), _
Cells(FinalRow, FinalCol)).Select
Set FoundCell = Selection.Find(what:=s, _
MatchCase:=True)
If Not FoundCell Is Nothing Then
BlankRow = FoundCell.Row
Rows(FoundCell.Row).Cut
Sheets("Sheet2"

.Activate
Cells(InitialRow + RowsCut, _
InitialCol).Select
ActiveSheet.Paste
RowsCut = RowsCut + 1
' Uncomment if you want to remove the
' blank row
Sheets("Sheet1"

.Activate
Rows(BlankRow).Delete shift:=xlUp
End If
Loop While Not FoundCell Is Nothing
End Sub