Spaltenbreite beim "Datei zerlegen"

Sub Zerlegen_Speichern()
Pfad = "T:\LLE 2014\"                                 'Speicherort festlegen (Ordner)
Dim wkbOld As Workbook
Dim wkbNew As Workbook
Set wkbOld = ActiveWorkbook
Dim rng As Range, rngCur As Range
Dim lngRow As Long
Application.ScreenUpdating = False
Set rngCur = Range("A1").CurrentRegion
rngCur.Sort _
key1:=Range("A2"), _
order1:=xlAscending, _
Header:=xlYes
lngRow = 2
Do Until IsEmpty(rngCur.Cells(lngRow, 1))
If rngCur.Cells(lngRow, 1)  rngCur.Cells(lngRow - 1, 1) Then
rngCur.AutoFilter _
field:=1, _
Criteria1:=rngCur.Cells(lngRow, 1)
Set rng = rngCur.SpecialCells(xlCellTypeVisible)
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ws = rngCur.Cells(lngRow, 1)
ActiveSheet.Name = ws
rng.Copy Range("A1")
Lieferant = Sheets(5).Name                         'hier wird der Dateiname festgelegt
ActiveSheet.Copy
Columns("A:L").EntireColumn.AutoFit             'Breite setzen
Set wkbNew = ActiveWorkbook
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
wkbOld.Sheets("UL").Cells.Copy
wkbNew.Sheets("Tabelle2").Range("A1").PasteSpecial
wkbNew.Sheets("Tabelle2").Name = wkbOld.Sheets("UL").Name
ActiveSheet.Protect Password:="bd12", UserInterfaceOnly:=True, DrawingObjects:=True, _
_
_
_
_
_
_
Contents:=True, Scenarios:=True
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
wkbOld.Sheets("LETyp").Cells.Copy
wkbNew.Sheets("Tabelle3").Range("A1").PasteSpecial
wkbNew.Sheets("Tabelle3").Name = wkbOld.Sheets("LETyp").Name
ActiveSheet.Protect Password:="bd12", UserInterfaceOnly:=True, DrawingObjects:=True, _
_
_
_
_
_
_
Contents:=True, Scenarios:=True
Worksheets.Move before:=Worksheets("UL")
Range("A:M").AutoFilter
ActiveSheet.Protect Password:="bd12", UserInterfaceOnly:=True, DrawingObjects:=True, _
_
_
_
_
_
_
Contents:=True, Scenarios:=True, AllowFiltering:=True
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.TopMargin = Application.CentimetersToPoints(1.5)
.BottomMargin = Application.CentimetersToPoints(1.5)
.LeftMargin = Application.CentimetersToPoints(0.5)
.RightMargin = Application.CentimetersToPoints(0.5)
.Zoom = 80
.CenterHorizontally = True
.PrintArea = ActiveSheet.UsedRange.Address
End With
wkbNew.SaveAs Filename:=Pfad & Lieferant   'Datei in Pfad speichern
wkbNew.Close
Application.DisplayAlerts = False
ActiveSheet.Delete                              'Blatt löschen
Application.DisplayAlerts = True
End If
lngRow = lngRow + 1
Loop
Worksheets(1).Select
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = False
End Sub