Copier plusieurs colonnes d'une feuille dans plusieurs feulles

Private Sub CommandButton1_Click()
Dim i%, a$, j%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---RAZ---
Me.Move Before:=Sheets(1)
For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next
'---création des feuilles---
With Range("A1", UsedRange).EntireColumn
    For i = 4 To .Columns.Count
        a = Split(.Columns(i).Address(0, 0), ":")(0)
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "ABC-" & a
        j = .Cells(2, i).MergeArea.Columns.Count 'pour DM2:DN2 qui sont fusionnées
        Union(.Columns(1).Resize(, 3), .Columns(i).Resize(, j)).Copy ActiveSheet.Range("A1")
        i = i + j - 1
    Next
End With
Me.Activate
End Sub

Private Sub CommandButton1_Click()
Dim i%, j%
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si un nom de feuille est déjà utilisé
'---RAZ---
Me.Move Before:=Sheets(1)
For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next
'---création des feuilles---
With Range("A1", UsedRange).EntireColumn
    For i = 4 To .Columns.Count
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = .Cells(2, i) & " " & .Cells(3, i)
        j = .Cells(2, i).MergeArea.Columns.Count 'pour DM2:DN2 qui sont fusionnées
        Union(.Columns(1).Resize(, 3), .Columns(i).Resize(, j)).Copy ActiveSheet.Range("A1")
        ActiveSheet.Columns(4).Resize(, j).AutoFit 'ajustement largeur
        i = i + j - 1
    Next
End With
Me.Activate
End Sub

Private Sub CommandButton1_Click()
Dim chemin$, d As Object, i%, x$, nomfich$, dL%, wb As Workbook, F As Worksheet, j%
chemin = ThisWorkbook.Path & "\Mes fichiers\" 'nom du dossier à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'---création des classeurs---
MkDir chemin 'création du sous-dossier
Set d = CreateObject("Scripting.Dictionary")
With Range("A1", UsedRange).EntireColumn
    For i = 4 To .Columns.Count
        x = .Cells(2, i)
        nomfich = Split(x)(0) & ".xls"
        dL = Len(x) + Len(.Cells(3, i)) - 30 'nom d'onglet limité à 31 caractères
        If Not d.exists(nomfich) Then
            d(nomfich) = ""
            Workbooks(nomfich).Close
            Workbooks.Add(xlWBATWorksheet).SaveAs chemin & nomfich, 56 'fichier .xls
        End If
        Set wb = Workbooks(nomfich)
        Set F = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)) 'nouvelle feuille
        F.Name = Left(x, Len(x) - dL) & " " & .Cells(3, i)
        j = .Cells(2, i).MergeArea.Columns.Count 'pour DM2:DN2 qui sont fusionnées
        Union(.Columns(1).Resize(, 3), .Columns(i).Resize(, j)).Copy F.Range("A1")
        F.Columns(4).Resize(, j).AutoFit 'ajustement largeur
        i = i + j - 1
    Next i
End With
'---fermeture des classeurs---
For Each wb In Workbooks
    If d.exists(wb.Name) Then
        wb.Activate
        wb.Sheets(1).Delete
        wb.Sheets(1).Activate
        wb.Close True 'avec enregistrement
    End If
Next wb
End Sub