Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

EXCEL VBA Columns Autofit
#1
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?
Antwortento top
#2
Hallo,
StZett.Columns("A:I").EntireColumn.AutoFit
Gruß Uwe
Antwortento top
#3
(08.07.2020, 10:10)Kuwer schrieb: Hallo,
StZett.Columns("A:I").EntireColumn.AutoFit
Gruß Uwe


*Facepalm*

very nice 
VIELEN DANK
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste