質問の冒頭だと､特定のｷｰﾜｰﾄﾞを探すような感じですが､

そして5行目以下のBF列にもし､空白ｾﾙではなく文字列ﾃﾞｰﾀが入っていた場合｡

というのは､空のｾﾙじゃなければ貼り付け､というふうに読めます｡

判定のところ以外は一緒なので､ふたつ用意しました｡

こちらは､特定のｷｰﾜｰﾄﾞを探すｲﾒｰｼﾞ｡

Const MAX_ROW = 50000  ' 処理対象の最大行数

Sub copy_bb_be()

 keyword = "あい" ’BF列で探したいｷｰﾜｰﾄﾞ

 look_col = 58  ' BF列
 copy_col = 54  ' BB列
 copy_row = 4
 paste_col = copy_col  ' BB列

  ' BB4:BE4 をｺﾋﾟｰ
 Range(Cells(copy_row, copy_col), Cells(copy_row, copy_col + 3)).Copy

 last_row = Cells(Rows.Count, look_col).End(xlUp).Row

 For r = 5 To last_row
 If InStr(Cells(r, look_col).Value, keyword) > 0 Then
 Cells(r, paste_col).Select
 ActiveSheet.Paste
 End If
 DoEvents
 If r > MAX_ROW Then  ' 念のため
 Exit For
 End If
 Next

End Sub

こちらは､特定のｷｰﾜｰﾄﾞを探すのではなく､BF列が空ではないｾﾙだったら貼り付ける場合です｡

Const MAX_ROW = 50000  ' 処理対象の最大行数

Function is_blank_cell(c)
 is_blank_cell = IsEmpty(c) Or c.Value = ""
End Function


Sub copy_bb_be()

 look_col = 58  ' BF列
 copy_col = 54  ' BB列
 copy_row = 4
 paste_col = copy_col  ' BB列

  ' BB4:BE4 をｺﾋﾟｰ
 Range(Cells(copy_row, copy_col), Cells(copy_row, copy_col + 3)).Copy

 last_row = Cells(Rows.Count, look_col).End(xlUp).Row

 For r = 5 To last_row
 If Not is_blank_cell(Cells(r, look_col)) Then
 Cells(r, paste_col).Select
 ActiveSheet.Paste
 End If
 DoEvents
 If r > MAX_ROW Then  ' 念のため
 Exit For
 End If
 Next

End Sub