XL 2010 lancer macro en restant sur userbox

Bonjour,
Voila j'ai créer un userbox, qui lance une macro qui créé une feuille, importe des données d'un fichier texte et les mets en forme.
j'aimerais restait sur mon userbox lorsque je lance cette macro, malheureusement je ne trouve pas comment faire à chaque fois je me retrouve sur la feuille.
Voici le code :
'test en generant la feuille

Sub Trt_test(nomFic As String)

Sheets.Add(after:=Sheets(Sheets.Count)).Name = "PREV"
Worksheets("PREV").UsedRange.Clear
clearQueryTables

'convertir et extraire .txt
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & nomFic, Destination:=Range("$A$1"))
'.Name = "OEIE.AMS_900210.txt"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
.Delete 'On supprime la Querytable
End With
'supprimer colonnes
Columns("F:F").Cut Destination:=Columns("K:K")
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Range("A:A,B:B").Delete


'supprimer ligne au dessus de asp
Dim p As Range
On Error Resume Next
Set p = Columns(1).Cells.Find("asp")
Rows("1:" & p.Row - 1).EntireRow.Delete
'Supprime la ligne de titre avec "Libelle" en colonne A
Columns(1).Find("Libelle", , , xlPart).EntireRow.Delete
'supprime tout en dessous de f/mat
On Error Resume Next
Range(Cells(Rows.Count, 1), Columns(1).Cells.Find("F/Mat")).EntireRow.Delete
' On supprime les espaces blancs dans la colonne A
Columns(1).Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'supprime ligne vides
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'intervertit colonne dts et cout mo
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Copy
Columns("I:I").Select
ActiveSheet.Paste
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

' Création tableau structuré
MiseEnFormeDeTableau



End Sub