Macro insertion de colonnes selon variable

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Byte, NbQl As Byte, j As Byte

If Not Intersect(Target, Range("A2")) Is Nothing Then
    If Range("A2").Value > 20 Then
        MsgBox "Nombre maxi(20) de colonnes dépassé"
        Exit Sub
    End If
    If Range("A2").Value = 0 Then
        MsgBox "Il doit y avoir au moins une colonne"
        Exit Sub
    End If
    
    For i = 4 To 24
        If Not Cells(2, i) Like "QL*" Then
            NbQl = i - 4 'détermination du nombre de col QL existant
            Exit For
        End If
    Next i
    
    If Range("A2").Value > NbQl Then
        For j = 4 + NbQl To 3 + Range("A2").Value
            Columns(j).Insert Shift:=xlToRight
            Cells(2, j) = "QL " & j - 3
            Range(Cells(1, 4), Cells(1, j)).MergeCells = True
        Next j
    Else
        For j = 3 + NbQl To 4 + Val(Range("A2").Value) Step -1
            Columns(j).Delete Shift:=xlToLeft
        Next j
    End If
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If [A2] = "" Or [B2] = "" Then Application.Undo
If Not Intersect(Target, [A2]) Is Nothing Then Insertion [A2], "QL"
If Not Intersect(Target, [B2]) Is Nothing Then Insertion [B2], "VR"
End Sub

Sub Insertion(c As Range, txt$)
Dim coldeb%, colfin%
'---1ère colonne---
coldeb = Application.Match(txt & 1, [2:2], 0)
'---dernière colonne---
colfin = Cells(2, Columns.Count).End(xlToLeft).Column
For colfin = colfin To coldeb Step -1
  If Cells(2, colfin) Like txt & "*" Then Exit For
Next
'---suppression ou insertion de colonnes---
If colfin - coldeb + 1 > c Then
  Columns(coldeb + c).Resize(, colfin - coldeb + 1 - c).Delete
ElseIf colfin - coldeb + 1 < c Then
  Columns(colfin + 1).Resize(, c - colfin + coldeb - 1).Insert
  Cells(2, coldeb).AutoFill Cells(2, coldeb).Resize(, c) 'remplissage
  Cells(1, coldeb).Resize(, c).Merge 'fusion
  Columns.AutoFit 'ajustement de la largeur
End If
End Sub

If c > 1 Then Cells(34, coldeb + 1).Resize(2, c - 1).UnMerge 'défusion
Cells(34, coldeb).Resize(2).AutoFill Cells(34, coldeb).Resize(2, c) 'remplissage

Private Sub Worksheet_Change(ByVal Target As Range)
If [A2] = "" Or [B2] = "" Then Application.Undo
If Not Intersect(Target, [A2]) Is Nothing Then Insertion [A2], "QL"
If Not Intersect(Target, [B2]) Is Nothing Then Insertion [B2], "VR"
End Sub

Sub Insertion(c As Range, txt$)
Dim coldeb%, colfin%, n%, r As Range
'---1ère colonne---
coldeb = Application.Match(txt & 1, [2:2], 0)
'---dernière colonne---
colfin = Cells(2, Columns.Count).End(xlToLeft).Column
For colfin = colfin To coldeb Step -1
  If Cells(2, colfin) Like txt & "*" Then Exit For
Next
'---suppression ou insertion de colonnes---
If colfin - coldeb + 1 > c Then
  Columns(coldeb + c).Resize(, colfin - coldeb + 1 - c).Delete
ElseIf colfin - coldeb + 1 < c Then
  Columns(colfin + 1).Resize(, c - colfin + coldeb - 1).Insert
  Cells(2, coldeb).AutoFill Cells(2, coldeb).Resize(, c) 'remplissage
  n = Application.CountIf([B:B], "CA PLANIFIES")
  Set r = [B1]
  For n = 1 To n
    Set r = [B:B].Find("CA PLANIFIES", r, xlValues)
    Cells(r.Row, coldeb + 1).Resize(2, c - 1).UnMerge 'défusion
    Cells(r.Row, coldeb).Resize(2).AutoFill Cells(r.Row, coldeb).Resize(2, c)
  Next
  Cells(1, coldeb).Resize(, c).Merge 'fusion
End If
Columns.AutoFit 'ajustement de la largeur
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If [A2] = "" Then [A2] = Application.CountIf([2:2], "QL*")
If [B2] = "" Then [B2] = Application.CountIf([2:2], "VR*")
If Not Intersect(Target, [A2]) Is Nothing Then Insertion [A2], "QL"
If Not Intersect(Target, [B2]) Is Nothing Then Insertion [B2], "VR"
End Sub

Sub Insertion(c As Range, txt$)
Dim coldeb%, colfin%, n%, r As Range
'---1ère colonne---
coldeb = Application.Match(txt & 1, [2:2], 0)
'---dernière colonne---
colfin = [2:2].Find(txt & "*", , xlValues, xlWhole, , xlPrevious).Column
'---suppression ou insertion de colonnes---
If colfin - coldeb + 1 > c Then
  Columns(coldeb + c).Resize(, colfin - coldeb + 1 - c).Delete
ElseIf colfin - coldeb + 1 < c Then
  Columns(colfin + 1).Resize(, c - colfin + coldeb - 1).Insert
  Cells(1, coldeb).Resize(, c).Merge 'fusion
  Cells(2, coldeb).AutoFill Cells(2, coldeb).Resize(, c) 'remplissage
  n = Application.CountIf([B:B], "CA PLANIFIES")
  Set r = [B1]
  For n = 1 To n
    Set r = [B:B].Find("CA PLANIFIES", r)
    Cells(r.Row, coldeb).Resize(2).Copy Cells(r.Row, coldeb + 1).Resize(2, c - 1)
  Next
End If
Columns.AutoFit 'ajustement de la largeur
End Sub