Macro pour creer feuille en fonction du contenu en Colonne A

Sub Macro2() [COLOR=SeaGreen]'macro issue de l'enregistreur de macro[/COLOR]
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
End Sub

Sub Macro3() [COLOR=SeaGreen]'la même macro réduite (en n' utilisant pas Select)[/COLOR]
Application.ScreenUpdating = False[COLOR=SeaGreen]' pour masquer le rafraichissement de l'écran[/COLOR]
Range([A1], [A1].End(xlDown)).TextToColumns Range("A1"), _
xlDelimited, xlDoubleQuote, False, False, False, False, _
False, True, "-", Array(Array(1, 1), Array(2, 1), Array(3, 1))
End Sub

Sub Abfrage()
Dim n As Integer, [COLOR=red]m As Integer, ligne As Integer[/COLOR]
Dim t As Variant
[COLOR=red]Dim Org_Sheet As String[/COLOR]
[COLOR=red]Org_Sheet = ActiveSheet.Name[/COLOR]
Application.ScreenUpdating = False
Dim numserie As Collection
Set numserie = New Collection
ligne = 2
Worksheets.Add.Name = "temp"
With Sheets([COLOR=red]Org_Sheet[/COLOR])
For n = 2 To .Range("A65536").End(xlUp).Row
t = Split(.Range("A" & n), "-")
Range("A" & ligne) = t(0)
Range("B" & ligne) = t(1)
Range("C" & ligne) = t(2)
ligne = ligne + 1
Next n
.Range("B2:[COLOR=magenta][B]H[/B][/COLOR]" & .Range("A65536").End(xlUp).Row).Copy Destination:=Range("D2")
[COLOR=magenta]'ici il faudrait que les colonnes soit toutes "copier" et pas seulement jusqu'a H car j'ai des fichier avec des colonne I et J[/COLOR]
End With
With Sheets("temp")
 For n = 2 To .Range("B65536").End(xlUp).Row
 On Error Resume Next
    numserie.Add .Range("B" & n), CStr(.Range("B" & n))
 On Error GoTo 0
 Next n
 For n = 1 To numserie.Count
  Worksheets.Add.Name = numserie(n)
  ligne = 2
  Sheets([COLOR=red]Org_Sheet[/COLOR]).Range("B1:[COLOR=#ff00ff][B]H[/B][/COLOR][COLOR=black]1[/COLOR]").Copy Destination:=Range("D1")
[COLOR=#ff00ff]'ici il faudrait que les colonnes soit toutes "copier" et pas seulement jusqu'a H car j'ai des fichier avec des colonne I et J[/COLOR]
  Range("A1") = "Codebarre"
  Range("B1") = "Seriennumber"
  Range("C1") = "Nest"
  [COLOR=red]Range("A1:C1").Select
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
Range("A2").Select
ActiveWindow.FreezePanes = True
[/COLOR][COLOR=#ff00ff]'ici jái rajouter la couleur pour l'entete et je fixe la ligne 1[/COLOR]
 
  With Sheets("temp")
  For m = 2 To .Range("B65536").End(xlUp).Row
     If .Range("B" & m) = numserie(n) Then
       .Range("A" & m & ":J" & m).Copy Destination:=Cells(ligne, 1)
       ligne = ligne + 1
     End If
  Next m
  End With
 Range("A1:[COLOR=magenta]J[/COLOR]" & Range("A65536").End(xlUp).Row).AutoFilter
[COLOR=#ff00ff]'ici il faudrait que les colonnes soit toutes "copier" et pas seulement jusqu'a J car j'ai des fichier avec des colonne K et L[/COLOR]
 Next n
End With
Application.DisplayAlerts = False
Sheets("temp").Delete
[COLOR=red]Sheets(Org_Sheet).Delete[/COLOR]
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 x = Sheets(nn).Range("IV1").End(xlToLeft).Column
 For z = 1 To x
   For y = 1 To Sheets(nn).Cells(65536, z).End(xlUp).Row
     If lmax < Len(Sheets(nn).Cells(y, z).Value) Then lmax = Len(Sheets(nn).Cells(y, z).Value)
   Next y
   Sheets(nn).Columns(z).ColumnWidth = lmax
   lmax = 0
 Next z