VBA, fichier des lignes avec une meme cellule

Option Explicit 

Sub Creer_Feuille() 

    Dim A As String 
    Dim Fle_Origine As String 
     
    ' Capture de la feuille active 
    Fle_Origine = ActiveSheet.Name 
     
    ' Capture de la valeur recherché 
    A = Cells(2, 1).Value 

    ' Si valeur différent de rien 
    If (A <> "") Then 
        ' Ajout d'une feuille au nom désiré 
        Sheets.Add.Name = A 
    End If 
     
    ' Retour à la feuille de départ 
    Sheets(Fle_Origine).Select 
     
    ' Ce bout ci n'est pas clair pour moi 
    ' veuillez détailler s.v.p. 
    ' Quel est la valeur de B, d'où vient cette variable ?
    If (B = Columns(1).Find(What:=A, _ 
                           After:=Cells(1, 1), _ 
                           LookIn:=xlValues, _ 
                           SearchOrder:=xlByRows, _ 
                           SearchDirection:=xlNext, _ 
                           MatchCase:=False, _ 
                           SearchFormat:=False).Activate Is True) Then 
                            
        Rows.Copy (Sheets(A)) 
         
    End If 

End Sub 
' 

Sub creerFeuilles()
    Dim nbcol As Long, lig As Long, derlig As Long, nomF As String, nlig As Long
    Dim sh1 As Worksheet, sh2 As Worksheet
    Application.ScreenUpdating = False
    Set sh1 = Worksheets("donnees")
    nbcol = [A1].End(xlToRight).Column
    derlig = [A65536].End(xlUp).Row
    For lig = 2 To derlig
        nomF = sh1.Cells(lig, 1)
        ' création de la feuille si besoin
        If Not existSh(nomF) Then
            Sheets.Add.Name = nomF
            ActiveSheet.Move After:=Worksheets(Worksheets.Count)
            sh1.Cells(1, 1).Resize(1, nbcol).Copy ActiveSheet.[A1]
        End If
        ' copie donnée
        nlig = 1
        While sh1.Cells(lig + nlig, 1) = sh1.Cells(lig, 1)
            nlig = nlig + 1
        Wend
        sh1.Cells(lig, 1).Resize(nlig, nbcol).Copy Worksheets(nomF).[A65536].End(xlUp).Offset(1, 0)
        lig = lig + nlig - 1
    Next lig
    Application.ScreenUpdating = True
    sh1.Activate
End Sub

Function existSh(nom As String) As Boolean
    ' test l'existence d'une feuille
    Dim b As Boolean
    On Error GoTo suite
    Sheets(nom).Activate
    b = True
suite:
    existSh = b
End Function

Set sh2 = Worksheets(sh1.Cells(lig, 1).Value)

Option Explicit

Sub creerFeuilles()

ActiveSheet.Name = "donnees"

    Dim nbcol As Long, lig As Long, derlig As Long ', ok As Boolean
    Dim sh1 As Worksheet, sh2 As Worksheet
    Set sh1 = ActiveSheet
    nbcol = [A1].End(xlToRight).Column
    derlig = [A65536].End(xlUp).Row
    For lig = 2 To derlig
        ' création de la feuille si besoin
        If Not existSh(sh1.Cells(lig, 1)) Then
            Sheets.Add.Name = sh1.Cells(lig, 1)
            ActiveSheet.Move After:=Worksheets(Worksheets.Count)
            sh1.Cells(1, 1).Resize(1, nbcol).Copy ActiveSheet.[A1]
        End If
        ' copie donnée
        
        Sheets("donnees").Activate
        
        Set sh2 = Worksheets(sh1.Cells(lig, 1).Value)
        sh1.Cells(lig, 1).Resize(1, nbcol).Copy sh2.[A65536].End(xlUp).Offset(1, 0)
    Next lig
End Sub

Function existSh(nom As String) As Boolean
    ' test l'existence d'une feuille
    Dim b As Boolean
    On Error GoTo suite
    Sheets(nom).Activate
    b = True
suite:
    existSh = b
End Function