Automatisation de taches

Sub ExporterActionsParCategories()
Dim fichier, t
Dim Wbk_Source As Workbook, Wbk_Cible As Workbook
Dim Wsh_Source As Worksheet
Dim Tbl_In(), Tbl_Temp()
Dim Plage As Range, Cel As Range
Dim i As Long, drlig As Long, fin As Long, cpt As Long, Pos As Long
Dim Colonne As String, maVar As String

t = Timer
'********** COLLECTE DES INFOS "Category" & "Action" *************
Set Wbk_Source = ThisWorkbook

'************************************************************************ A ADAPTER
'remplacer Feuil1 par le nom de la feuille contenant les category, actions etc.
Set Wsh_Source = Wbk_Source.Worksheets("Feuil1")
'**********************************************************************************FIN ADAPTATION
With Wsh_Source
    drlig = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
    fin = (drlig - 4) / 6
    cpt = 0
    ReDim Tbl_In(1 To 2, 1 To fin)
    For i = 4 To drlig Step 6
        cpt = cpt + 1
        Tbl_In(1, cpt) = .Range("B" & i).Value
        Tbl_In(2, cpt) = .Range("B" & i + 1).Value
    Next i
End With
'************ FIN COLLECTE ****************************************

'************ OUVERTURE FICHIER CIBLE *****************************
MsgBox "Choix du fichier cible"
fichier = Application.GetOpenFilename
If VarType(fichier) = vbBoolean Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
    Exit Sub
End If
Set Wbk_Cible = Workbooks.Open(fichier)
'************* Le fichier cible est ouvert ************************

'********** Choix de la colonne ou transférer les données *********
Set Plage = Application.InputBox("Sélectionner une seule cellule de la colonne ou vous voulez transférer les données", "Column choice", Type:=8)
If Not Plage Is Nothing And Plage.Count = 1 Then
    Colonne = Split(Plage.Address(ColumnAbsolute:=False), "$")(0)
Else
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
    Wbk_Cible.Close
    Exit Sub
End If
'**************** FIN CHOIX COLONNE *******************************

'**************** Restitution des données *************************
Set Plage = Application.InputBox("Sélectionner la plage contenant les catégories", "Category", Type:=8)
If Plage Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
    Wbk_Cible.Close
    Exit Sub
Else
    Application.ScreenUpdating = False
    For Each Cel In Plage
        For i = LBound(Tbl_In, 2) To UBound(Tbl_In, 2)
            If Cel.Value Like "*" & "|---" & Tbl_In(1, i) & "*" Then Cells(Cel.Row, Colonne) = Tbl_In(2, i): Exit For
        Next i
    Next Cel
    Application.ScreenUpdating = True
End If
'****************** FIN RESTITUTION ********************************
MsgBox "Exportation terminée en " & Timer - t & " secondes."
End Sub