VBA: mehrere workbooks & -sheets
Dani
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