Make pasted value in last blank cell the focus

[gotroots]

Whichever cell has the focus when the following code is run that is the row
that will be copied into any other sheet in the range.

What I need is the row containing the last blank cell in "B" in which the
value of "B9" take the focus, although the exact row to be copied wont be
determined until the sheet has first been sorted.

Here is the code in it entirety:

Option Explicit
Option Compare Text

Private Sub AddRow_Click()

Dim rng As Range
Dim lr As Long
Dim sh As Worksheet
Dim ws As Worksheet
Dim i As Integer
Dim FD As String 'find string
Dim Frow As Integer 'found row
Dim sel As String
Dim shname As String
Dim x As Long
Dim lngLastRow As Long

' remove filter
For x = 1 To Worksheets.Count
If Sheets(x).FilterMode Then
Sheets(x).ShowAllData
End If
Next

' insert value in last blank cell in "B"
If IsEmpty(Range("b9")) Then
MsgBox "No record found in B9.", vbInformation
Else
lngLastRow = Cells(Rows.Count, "B").End(xlUp).Row + 1

If lngLastRow <= 10 Then
Range("B10").Value = Range("B9").Value
Else
Cells(lngLastRow, "B").Value = Range("B9").Value
End If
End If


Application.ScreenUpdating = False

Set sh = ActiveSheet
shname = ActiveSheet.Name
FD = ActiveCell.Value
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh.Range("A11:H" & lr)
sel = Selection.Address
rng.Sort Range(sel), xlAscending

'Loop through the newly inserted row and copy formula from 1 cell above
Frow = Range("B:B").Find(FD, LookIn:=xlValues).Row
For i = 4 To 60 Step 2 'Change to extend if your Range grows.
Cells(Frow - 1, i).Copy Cells(Frow, i)
Next i

'Take new data and paste it on the Uses sheet.
For Each ws In ThisWorkbook.Worksheets
If Left((ws.Name), 4) = "Uses" And Not ws.Name = shname Then
Sheets(shname).Rows(Frow).Copy
ws.Cells(Frow, 1).Insert

Range("B10").Select
End If

Next ws

Application.ScreenUpdating = True

Application.CutCopyMode = False

End Sub


I hope I have explained the problem well enough.