Hallo Excel- Koryphäen,
Habe folgendes Problem, wo ich keinen passenden code im Archiv finden konnte.
Habe 17 xls-files mit je 2 worksheets.
Der Tabellen-Aufbau ist immer identisch und ich möchte nun für all diese 17 workbooks & deren 2 worksheets die Spaltenbreite anpassen und einige Spalten löschen. Ich habe den folgenden – sehr umständlichen – code gebastelt, und diesen eben 18x kopiert (mit dem entsprechenden Namen der xls-Datei) ….
HILFE – was muss ich tun?
Workbooks("BAAP.xls").Worksheets("check").Activate
Rows("1:1").Insert Shift:=xlDown
Workbooks("Master.xls").Worksheets("Master").Range("A2:o2").Copy Destination:=Workbooks("BAAP.xls").Sheets("check").Range("A1:o1")
Columns(1).ColumnWidth = 15.14
Columns(2).ColumnWidth = 55.43
Columns(3).ColumnWidth = 13.5
Columns(6).ColumnWidth = 22
Columns(4).Delete Shift:=xlToLeft
Range("F:G").Delete Shift:=xlToLeft
Cells.Select
Cells.EntireRow.AutoFit
Sheets("to do").Select
Rows("1:1").Insert Shift:=xlDown
Workbooks("Master.xls").Worksheets("Master").Range("A2:o2").Copy Destination:=Workbooks("BAAP.xls").Sheets("to do").Range("A1:o1")
Columns(1).ColumnWidth = 15.14
Columns(2).ColumnWidth = 55.43
Columns(3).ColumnWidth = 13.5
Columns(6).ColumnWidth = 22
Columns(4).Delete Shift:=xlToLeft
Range("F:G").Delete Shift:=xlToLeft
Range("A1:L1").AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="BAAP"
ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Cells.Select
Cells.EntireRow.AutoFit
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Ordner\BAAP" & "_" & Format(Date, "YYYY-MM-DD") & ".xls"
ActiveWorkbook.Close
p.s. den autofilter mach ich immer im worksheet „to do“, denn da sind doppelte Einträge aus dem worksheet „check“ drin sind. Wenn Ihr wisst, wie ich das auch schön lösen kann, bin ich Euch auf EWIG dankbar!
Viele Grüße
Dani