Auslesen mehrerer Dateien

Hallo zusammen,

Ich habe zur Zeit ein Problem, welches ich nicht selbstständig gelöst bekomme.
Folgende Ausgangssituation:
Ich habe einen Ordner mit ungefähr 150 Exceldateien. Alle Dateien verfügen über mehrere Tabellenblätter (Tabelle 1, Tabelle 2, ) und haben den gleichen Aufbau.
Nun möchte ich aus jeder Datei einzelne Werte in ein neues Dokument einfügen. So möchte ich beispielsweise aus Tabelle 1 den Inhalt aus Zelle I5 und E5 und aus Tabelle 2 den Inhalt aus C7 und D7 jeweils in eine einzelne Spalte meiner neuen Datei schreiben und dies für jede dieser Dateien machen, sodass der Inhalt aus Zelle I5 untereinander geschrieben wird (für die anderen ebenso). Ich habe bereits versucht dieses Problem mit Power Query anzugehen, hatte damit jedoch keinen Erfolg. Habt ihr Ideen wie man dies in VBA umsetzen kann?

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo

hier mal eine VBA Lösung, bei der Die Werte über Formel ausgelesen werden, ohne die Dateien zu öffnen.

In ein normales Modul



Sub alle_Dateien_Verzeichnis() '

    On Error GoTo Fehler

    Dim Pfad As String, Ext As String, Datei As String

    Dim TB As Worksheet, Sp As Integer, LR As Long

    

    Set TB = ThisWorkbook.Sheets("Tabelle1")

    Sp = 1 'Daten in Spalte A beginnend

    

    Ext = "*.xlsx"

    Pfad = "d:\excel\Temp\" '**** mit \

    

    

    With TB

        'reset

        .UsedRange.ClearContents

        

        Datei = Dir(Pfad & Ext)

        Do While Len(Datei) > 0

        

            LR = .Cells(.Rows.Count, Sp).End(xlUp).Row + 1 'erste freie Zeile Spalte



            .Cells(LR, Sp).FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Tabelle1'!R5C9" '***R5 = Zeile5 C9= Spalte9  Also I5

            .Cells(LR, Sp + 1).FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Tabelle1'!R5C5"

            

            .Cells(LR, Sp + 2).FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Tabelle2'!R7C3"

            .Cells(LR, Sp + 3).FormulaR1C1 = "='" & Pfad & "[" & Datei & "]Tabelle2'!R7C4"

            

            'ggf Dateiname

            .Cells(LR, Sp + 5) = Datei

            

            Datei = Dir() ' nächste Datei

        Loop

        

        'Formeln in Wert

        .UsedRange.Value = .UsedRange.Value

    End With

    

    Err.Clear

Fehler:

    If Err.Number > 0 Then MsgBox "Fehler: " & _

        Err.Number & vbLf & Err.Description: Err.Clear



End Sub

LG UweD

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread