Copiar un numero con texto en otra celda

Tengo un código que me une libros de excel lo que me hace falta es que en me seleccione la celda A3 donde tengo esta info: "Account: A02 Turbo Rest / *4385" quiero que me deje unicamente el "4385" y lo pegue en la celda F6 y quiero que repita el mismo procedimiento para cada archivo de excel que se una.

Gracias!

Este es el código que tengo:

'********Aplicacion Unificar archivos de excel(*.xlsx) en un solo libro----------
Sub Open_Files()
Dim Hoja As Object

Application.ScreenUpdating = False
'Definir la variable como tipo Variante
Dim X As Variant
'Abrir cuadro de dialogo
X = Application.GetOpenFilename _
("Excel Files (*.csv), *.csv", 2, "Abrir archivos",, True)
'Validar si se seleccionaron archivos
If IsArray(X) Then ' Si se seleccionan
'Crea Libro nuevo
Workbooks. Add
'Captura nombre de archivo destino donde se grabaran los archivos seleccionados
A = ActiveWorkbook.Name
'*/********************
For y = LBound(X) To UBound(X)
Application.StatusBar = "Importando Archivos: " & X(y)
Workbooks.Open X(y)
b = ActiveWorkbook.Name
For Each Hoja In ActiveWorkbook.Sheets
Hoja.Copy after:=Workbooks(A).Sheets(Workbooks(A).Sheets.Count)
Next
Workbooks(b).Close False
Next
Application.StatusBar = "Listo"
Call Unir_Hojas
End If
Application.ScreenUpdating = False
End Sub

Sub Unir_Hojas()
Dim Sig As Byte, Eliminar As Boolean
For Sig = 2 To Worksheets.Count
Worksheets(Sig).UsedRange.Copy _
Worksheets(1).Range("a1000000").End(xlUp).Offset(1)
Next
Application.DisplayAlerts = False
For Sig = 2 To Worksheets.Count
Worksheets(2).Delete
Next
Application.DisplayAlerts = True

End Sub