EXCEL VBA Columns Autofit

[CHASiN1994]

Guten Tag liebe VBA´ler,

ich bringe dabei aus einer Excel Datei bestimmte Spalten in eine andere Excel Datei einzufügen.

folgender Code:

Code:

Option Explicit         '3.12.2018   Mitarbeiterplan Master Versuch

Const UserPfad = "F:\2. Poolordner Aurelium\880_Allgemein\1. Markt und Interessenten\1. Interessenten\1. Aktuell\10. Vital Convenience\2. Personalplanung\Aushang_VC.xlsx"

Sub Daten_inAushang_kopieren()
Dim WB As Workbook, StZett As Object
Dim Sht As Worksheet, Blatt As String

On Error GoTo openErr   'Open Fehler
Application.ScreenUpdating = False
Application.Calculation = xlManual

neu:  'Neustart bei Open Fehler
Set WB = Workbooks("Aushang_vc.xlsx")

On Error Resume Next
Blatt = ThisWorkbook.Worksheets("Plan VC YF").[C1].Value
'Prüfung ob Blatt vorhanden, sonst erstellen
If IsMissing(WB.Worksheets(Blatt)) Then
  WB.Worksheets.Add before:=Worksheets(1)
  WB.Worksheets(1).Name = Blatt
  Err = 0   'Err Nummer löschen
End If

Set StZett = WB.Worksheets(Blatt) 'Zieltabelle

On Error GoTo Fehler  'sonstige Fehler
With ThisWorkbook.Worksheets("Plan VC YF")

.Range("A1:A25").Font.Size = 16
.Range("C1:D25").Font.Size = 16
.Range("F1:F25").Font.Size = 16
.Range("H1:I25").Font.Size = 16
.Range("K1:K25").Font.Size = 16
.Range("M1:N25").Font.Size = 16

     'Bereiche (B2:G32) nur Werte aus PlanHF kopieren
     '** Range mit Punkt davor bezieht sich auf die With Klammer!!
      .Range("A1:A25").Copy   'Quelltabelle kopieren
     StZett.Range("A1").PasteSpecial Paste:=xlValues
     StZett.Range("A1").PasteSpecial Paste:=xlPasteFormats
     
     .Range("C1:D25").Copy   'Quelltabelle kopieren
     StZett.Range("B1").PasteSpecial Paste:=xlValues
     StZett.Range("B1").PasteSpecial Paste:=xlPasteFormats
     'nur Werte in Zieltabelle einfügen = xlPasteValues

     .Range("F1:F25").Copy   'Werte aus J2:N32 kopieren
     StZett.Range("D1").PasteSpecial xlPasteValues
     StZett.Range("D1").PasteSpecial Paste:=xlPasteFormats
     
     .Range("H1:I25").Copy   'Werte aus R2:Y32 kopieren
     StZett.Range("E1").PasteSpecial xlPasteValues
     StZett.Range("E1").PasteSpecial Paste:=xlPasteFormats
     
     .Range("K1:K25").Copy   'Werte aus R2:Y32 kopieren
     StZett.Range("G1").PasteSpecial xlPasteValues
     StZett.Range("G1").PasteSpecial Paste:=xlPasteFormats
     
     .Range("M1:N25").Copy   'Werte aus R2:Y32 kopieren
     StZett.Range("H1").PasteSpecial xlPasteValues
     StZett.Range("H1").PasteSpecial Paste:=xlPasteFormats
     
   
     'Einzelzellen B1,C1 mit Werte aus PlanHF laden


     Application.Calculation = xlAutomatic
     
     StZett.Activate   '** kann gelöscht werden !!
     Application.ScreenUpdating = True
     MsgBox "Alles fehlerfrei kopiert"



     WB.Save       'Stundenzettel speichern
     'Stundenzettel schliessen wäre WB.Close
End With
Exit Sub

openErr:  'Stundenzettel nicht geöffnet!
  Workbooks.Open Filename:=UserPfad
  If ActiveWindow.Caption = "Aushang_VC.xlsx" Then
     ThisWorkbook.Activate:  GoTo neu  'Neustart
  End If
  Application.Calculation = xlAutomatic
  MsgBox "Fehler:  Aushang konnte nicht geöffnet werden!"
Exit Sub

Fehler:  'unerwartete Fehlermeldung
  Application.Calculation = xlAutomatic
  MsgBox "unerwarteter Fehler:  " & Chr(10) & Error()
End Sub

Nun möchte ich, dass in der anderen Datei "Aushang_VC" die Spalten automatisch auf autobreite gestellt werde.
meine Recherche ergab diesen Code:

Code:

Columns("A:I").EntireColumn.AutoFit

ABER
es passiert gar nichts. Es kann sein, dass ich in die falsche Stelle eingecoded habe.
kann mir jemand Unterstützung leisten?

[Kuwer]

Hallo,

StZett.Columns("A:I").EntireColumn.AutoFit

Gruß Uwe

[CHASiN1994]

Hallo,

StZett.Columns("A:I").EntireColumn.AutoFit

Gruß Uwe

*Facepalm*

very nice 
VIELEN DANK