récupRécupération d’une variable dans des cases Excel

Sub Test2()
Dim DerLig As Integer, I As Integer, Message As String
Dim Feuille As Worksheet, Base As Worksheet, Flag As Boolean
Set Base = ActiveSheet
DerLig = Base.Range("A65536").End(xlUp).Row
For I = 2 To DerLig
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name = Base.Cells(I, 1) Then Flag = True
Next Feuille
If Flag = True Then
Message = Message & Base.Cells(I, 1) & " ; "
Flag = False
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Base.Cells(I, 1)
End If
Next I
If Message <> "" Then
Message = Left(Message, Len(Message) - 3)
Message = "Les feuilles suivantes n'ont pu être créées car elles existaient déjà :" _
    & vbCrLf & Message
MsgBox Message, vbCritical + vbOKOnly, "ATTENTION !"
End If
End Sub

Sub Test()
Dim DerLig As Integer, DerCol As Integer, Ligne As Integer
Dim I As Integer, J As Integer, K As Integer, L As Integer
Dim Message As String, MonNom As String, Temp
Dim Feuille As Worksheet, Base As Worksheet, Flag As Boolean
Set Base = ActiveSheet
DerLig = Base.Range("A65536").End(xlUp).Row
For I = 2 To DerLig
Temp = Split(Base.Cells(I, 1), ";")
For L = LBound(Temp) To UBound(Temp)
MonNom = Application.WorksheetFunction.Proper(Trim(Temp(L)))
For Each Feuille In ThisWorkbook.Worksheets
If Feuille.Name = MonNom Then Flag = True
Next Feuille
If Flag = True Then
Message = Message & MonNom & " ; "
Flag = False
Else
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = MonNom
End If
Ligne = 2
With Sheets(MonNom)
.Cells.Clear
.Range("A1:C1").Interior.ColorIndex = 36
.Range("A1:C1").Font.Bold = True
.Range("A1") = "Article"
.Range("B1") = "Référence"
.Range("C1") = "Date d'arrivée"
DerCol = Evaluate("COUNTA(Feuil1!C" & I & ":D" & I & ")") + 2
If DerCol <> 2 Then
.Range("A" & Ligne) = MonNom
.Range("A" & Ligne).Font.Bold = True
.Range("A" & Ligne).Interior.ColorIndex = 24
End If
For J = 3 To DerCol
For K = 1 To Base.Cells(I, J)
.Range("B" & Ligne) = Application.WorksheetFunction.Proper(Base.Cells(1, J)) & "." & K
.Range("C" & Ligne) = Base.Cells(I, 5)
Ligne = Ligne + 1
Next K
Next J
With .Range("A1:C" & Ligne - 1)
.EntireColumn.AutoFit
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End With
Next L
Next I
If Message <> "" Then
Message = Left(Message, Len(Message) - 3)
Message = "Les feuilles suivantes n'ont pu être créées car elles existaient déjà :" _
    & vbCrLf & Message
MsgBox Message, vbCritical + vbOKOnly, "ATTENTION !"
End If
End Sub