Office: Mehrere xls zusammenkopieren

Hallo zusammen,

ich habe folgende Fragestellung. In der Suche hier und in der Online-Hilfe von Excel bin ich leider nicht fündig geworden. Möglicherweise hilft hier auch nur eine VBA-Erweiterung/-Makro.

Ich habe mehrere gleich strukturierte und formatierte xls-Dateien (mit Überschriften, ca. 25 Spalten und verschieden viele Zeilen (max. 30), ein Tabellenblatt). Alle sind im gleichen Ordner abgelegt.
Nun möchte ich ein "Sammel-xls" erstellen, das bei jedem Aufruf/Öffnen alle einzelnen xls-Dateien in dem Ordner jeweils als separates Tabellenblatt zusammenführt. Das draf ruhig ein paar Minuten dauern, da das nur alle paar Tage aufgrerufen wird.
Die Darstellung soll dem des Ausgangs-xls entsprechen. Es werden rd. 60-70 einzelne Dateien sein.
Ich habe schon via "Hyperlink" und "einfügen von Objekt aus Datei" herumprobiert, komme aber nicht zum gewünschten Ergebnis.
VBA kann ich leider nicht.

Da das Sammel-xls beim Öffnen die Tabellenblätter wieder neu erzeugen soll, kann dies auch als Import-Lösung realisiert werden.

Hat jemand einen Tipp, um das aus Excel heraus zu lösen bzw. hat jemand eine VBA-Lösung für das Problem ?

Viele Dank,

Skipper

 

Hi,

versuche es mit diesem Makro:

Code:

Sub ArbeitsmappenZusammen()
    Dim strVerzeichnis As String
    Dim strTyp As String
    Dim strDateiname As String
    strTyp = "*.xl*"
    Application.ScreenUpdating = False
    strVerzeichnis = "D:\Eigene Dokumente\Excel"
    If Right(strVerzeichnis, 1) <> "\" Then strVerzeichnis = strVerzeichnis & "\"
    strDateiname = Dir(strVerzeichnis & strTyp)
    Application.ScreenUpdating = False
    With ThisWorkbook
        Do While strDateiname <> ""
            Workbooks.Open Filename:=strVerzeichnis & strDateiname
            Workbooks(strDateiname).Worksheets(1).Copy after:=.Worksheets(.Worksheets.Count)
            Workbooks(strDateiname).Close False
            strDateiname = Dir
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

Bis später,
Karin

 

Hallo Karin,

Du bist spitze :-)
Das funktioniert so wie ich mir das vorgestellt habe.
Wenn man jetzt das Verzeichnis noch über einen Dialog auswählen könnte, wäre es perfekt.
Muss aber nicht sein.
Danke Dir auf jeden Fall für die schöne und rasche Hilfe.

GRuss
Skipper

 

Hi Skipper,

das sollte so gehen:

Code:

Sub ArbeitsmappenZusammen()
    Dim strVerzeichnis As String
    Dim strTyp As String
    Dim strDateiname As String
    strTyp = "*.xl*"
    Application.ScreenUpdating = False
    strVerzeichnis = GetFolder
    If strVerzeichnis <> "" Then
      If Right(strVerzeichnis, 1) <> "\" Then strVerzeichnis = strVerzeichnis & "\"
      strDateiname = Dir(strVerzeichnis & strTyp)
      Application.ScreenUpdating = False
      With ThisWorkbook
          Do While strDateiname <> ""
              Workbooks.Open Filename:=strVerzeichnis & strDateiname
              Workbooks(strDateiname).Worksheets(1).Copy after:=.Worksheets(.Worksheets.Count)
              Workbooks(strDateiname).Close False
              strDateiname = Dir
          Loop
      End With
      Application.ScreenUpdating = True
   End If
End Sub

Function GetFolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = "D:\"
        .ButtonName = "OK"
        .Title = "Ordnerauswahl"
        .Show
        If .SelectedItems.Count = 0 Then
            GetFolder = ""
        Else
            GetFolder = .SelectedItems(1)
        End If
    End With
End Function

Bis später,
Karin

 

Hallo Karin,

funktioniert spitzenmäßig.
Nochmals DANKE

Gruss
Skipper