Sub Transfer()
    
TransferNumber = InputBox(Prompt:="Transfer Number?", Title:="Number?")
With Sheets("Transfer Log").Range("A:A")
    Set fndNum = .Find(TransferNumber, LookIn:=xlValues)
    If Not fndNum Is Nothing Then   '<~~ the transfer number was found
        firstAddress = fndNum.Address
        Do
            With Sheets("Transfer Form")
                'find the row to write to
                writeRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                .Cells(writeRow, 1).Resize(1, 4).Value = fndNum.Offset(0, 2).Resize(1, 4).Value
            End With
            Set fndNum = .FindNext(fndNum)
        Loop While Not fndNum Is Nothing And fndNum.Address <> firstAddress
    End If
End With

End Sub