Copying values from one sheet to another
Lowest Hanging VBA Fruit:

Public Sub ()
    Application.ScreenUpdating = False
    Application.EnableEvents= False
    Application.Calculation= XlManual

    ...

    Code

    ...

    Application.ScreenUpdating = True
    Application.EnableEvents= True
    Application.Calculation= XlAutomatic
End Sub


Every time you access the worksheet, events trigger, formulas recalculate and Excel re-draws the screen.
You're accessing the worksheet 4,000 times.
Turning those options off will make your code inordinately faster. Just make sure they get reset back to normal at the end.



Superfluous Logic

If rCell.Value &lt;&gt; "" Then
    If Len(rCell.Value) &gt; 3 Then


If Len(value) &gt; 0 then, by definition, value is not an empty string. So you can just drop rCell.Value &lt;&gt; "".



Use row/column numbers. not Strings and offsets.

This is more of a good practice thing. Get in the habit of using Cells(Row, Column) instead of Range("B" &amp; number).

Like so:

Dim finalRow As Long
Dim iRow As Long
Const TARGET_COL As Long = 2
Dim cellText As String

For iRow = 2 To finalRow

    cellText = WSS.Cells(iRow, TARGET_COL).Text

    If Len(cellText) &gt; 3 Then
        '/ Do Stuff
    End If

Next iRow