Remplissage d’un Bordereau pré imprimé par un code VBA

Option Explicit
Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ShtD As Worksheet
Dim Dl1 As Long ' dernière ligne
Dim data1 As String
Dim cellule As Range

If flag = True Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("b9:b9" & Dl1)) Is Nothing Then
   flag = True
   With Sheets(Target.Worksheet.Name)
    Dl1 = 13
   .Range("A13:K31").ClearContents
   .Range("c32:K32").ClearContents
   
   Set ShtD = Sheets("SFE")
   Application.ScreenUpdating = False
        For Each cellule In ShtD.Range("j4:j" & ShtD.Range("j" & Rows.Count).End(xlUp).Row)
            If cellule = Target Then
                .Range("a" & Dl1) = ShtD.Range("b" & cellule.Row)
                .Range("c" & Dl1) = ShtD.Range("f" & cellule.Row) & " " & ShtD.Range("g" & cellule.Row) & " " & ShtD.Range("h" & cellule.Row)
'************************
' à modifier et à compléter si nécessaire
                .Range("f" & Dl1) = ShtD.Range("b" & cellule.Row)
                .Range("g" & Dl1) = ShtD.Range("d" & cellule.Row)
                .Range("h" & Dl1) = ShtD.Range("e" & cellule.Row)
                .Range("i" & Dl1) = ShtD.Range("f" & cellule.Row)
                .Range("j" & Dl1) = ShtD.Range("m" & cellule.Row)
'**************
                
            
                Dl1 = Dl1 + 1
                If Dl1 = 32 Then Exit Sub ' le nombre de lignes est limité
            End If
        Next cellule
        
    Application.ScreenUpdating = True
    End With
End If
flag = False


End Sub