Makro:Blätter aus offenen Dateien zusammen holen

Aus XIMES

Holt bestimmte Blätter aus verschiedenen GEÖFFNETEN Dateien zusammen

Sub Blätter_Einspielen_aus_Geöffneten_Datei()
  ' Modul zum Zusammenfassen mehrerer Blätter aus verschiedenen Dateien
  'Teilaufgabe = ALLE BLÄTTERN EINSPIELEN xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  '
  Dim DateiName As String
  Dim LaufenderDateiName As String
  Dim Datei As Workbook
  Dim Blattname As String
  '
  Dim DateiNameDerHauptdatei As String
  '
  DateiNameDerHauptdatei = ActiveWorkbook.Name
  ' ACHTUNG Fehlerfalle
  ' Das von leerer Datei aus Starten
  ' Wenn das erste Blatt in leerer Datei Sheets1
  '
  For Each Datei In Application.Workbooks
      '
      If Datei.Name <> "" And DateiNameDerHauptdatei <> Datei.Name Then
          '
          Datei.Activate
          '
          Blattname = ActiveWorkbook.Sheets(1).Name '<<< ANPASSEN
          Sheets(Blattname).Name = Datei.Name  '<<< ANPASSEN
          Sheets(Datei.Name).Copy After:=Workbooks(DateiNameDerHauptdatei).Sheets(Workbooks(DateiNameDerHauptdatei).Sheets.Count)
          Sheets(Datei.Name).Select
          '
          Datei.Close
          '
      End If
  Next
  '
  End Sub