Microsoft Excel

Herbers Excel/VBA-Archiv

VBA: mehrere workbooks & -sheets | Herbers Excel-Forum


Betrifft: VBA: mehrere workbooks & -sheets von: Dani
Geschrieben am: 02.08.2012 13:59:49

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

  

Betrifft: AW: VBA: mehrere workbooks & -sheets von: Rudi Maintaire
Geschrieben am: 02.08.2012 14:21:51

Hallo,
ich geh mal davon aus, dass alle Workbook geöffnet sind und der Code in Master.xls steht.

Sub BAAP()
  Dim wkb As Workbook
  For Each wkb In Workbooks
    If Not wkb.Name = ThisWorkbook.Name Then
      With wkb
        With .Worksheets("check")
          .Rows("1:1").Insert Shift:=xlDown
          ThisWorkbook.Worksheets("Master").Range("A2:O2").Copy .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
          .Rows.AutoFit
        End With
        With .Sheets("to do")
          .Rows("1:1").Insert Shift:=xlDown
          ThisWorkbook.Worksheets("Master").Range("A2:O2").Copy Destination:=.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 Field:=3, Criteria1:="BAAP"
          .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
          .ShowAllData
          .Rows.AutoFit
        End With
        Application.DisplayAlerts = False
        .SaveAs Filename:="C:\Ordner\BAAP" & "_" & Format(Date, "YYYY-MM-DD") & ".xls"
        .Close
      End With
    End If
  Next
End Sub

Gruß
Rudi


  

Betrifft: AW: VBA: mehrere workbooks & -sheets von: Dani
Geschrieben am: 02.08.2012 14:52:03

Hallo Rudi,

ja, die workbooks sind alle offen und das Makro ist im Master enthalten. Aber muss ich die 17 files nicht irgendwie separat benennen, denn beim speichern würde der code jedes mal die gerade bearbeitete Datei mit dem filename als „BAAP_xxx“ überschreiben, oder sehe ich das falsch? Wie bastelt man da die 17 filenamen rein?

Danke nochmal!
Dani


  

Betrifft: AW: VBA: mehrere workbooks & -sheets von: Rudi Maintaire
Geschrieben am: 02.08.2012 15:04:04

Hallo,
denn beim speichern würde der code jedes mal die gerade bearbeitete Datei mit dem filename als „BAAP_xxx“ überschreiben,
hab ich glatt übersehen.

Sub Dani()
  Dim wkb As Workbook, strName As String
  For Each wkb In Workbooks
    If Not wkb.Name = ThisWorkbook.Name Then
      strName = Left(wkb.Name, InStrRev(wkb.Name, ".") - 1)
      With wkb
        With .Worksheets("check")
          .Rows("1:1").Insert Shift:=xlDown
          ThisWorkbook.Worksheets("Master").Range("A2:O2").Copy .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
          .Rows.AutoFit
        End With
        With .Sheets("to do")
          .Rows("1:1").Insert Shift:=xlDown
          ThisWorkbook.Worksheets("Master").Range("A2:O2").Copy Destination:=.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 Field:=3, Criteria1:="BAAP"
          .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
          .ShowAllData
          .Rows.AutoFit
        End With
        Application.DisplayAlerts = False
        .SaveAs Filename:="C:\Ordner\" & strName & "_" & Format(Date, "YYYY-MM-DD") & ".xls"
        .Close
      End With
    End If
  Next
End Sub

Gruß
Rudi


  

Betrifft: P E R F E K T !! Problem gelöst & VIELEN Dank Rudi von: Dani
Geschrieben am: 02.08.2012 16:06:57

Kann ich eigentlich die versehentlich 3x eingestellten Beiträge in diesem Forum löschen?


  

Betrifft: Beitrag löschen geht nicht. owT von: Rudi Maintaire
Geschrieben am: 02.08.2012 16:08:33




  

Betrifft: Das macht dann schon Nepumuk! :-) orT von: Luc:-?
Geschrieben am: 02.08.2012 18:58:00

Gruß Luc :-?


Beiträge aus den Excel-Beispielen zum Thema "VBA: mehrere workbooks & -sheets"