Excel Dateien aus Ordner auslesen ..

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stefan,
probier mal diesen Code. (Kommentare beachten!)
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Daten_Lesen()
Dim strPath As String, strFile As String, strTabName As String
Dim lngR As Long

strPath = "F:\Temp\km\" 'Verzeichnis anpassen!

strTabName = "Tabelle1" 'Name der Tabellenblätter anpassen!

strFile = Dir(strPath & "*.xls")

lngR = 1

With ThisWorkbook.Sheets("Tabelle1") 'Name der Ausgabetabelle anpassen!

    .Range("A2:B" & Rows.Count).ClearContents

    Do Until strFile = ""
        lngR = lngR + 1
        .Cells(lngR, 1) = strFile
        .Cells(lngR, 2).Formula = "=SUM('" & strPath & "[" & strFile & "]" & _
            strTabName & "'!$K$7:$K$17)"
        .Cells(lngR, 2) = .Cells(lngR, 2).Value
        strFile = Dir
    Loop

End With

End Sub

Gruß Sepp

Hallo Stefan,
folgendes Makrobeispiel erstellt eine neue Abeitsmappe und liest dann die Dateien im Verzeichnis aus.


Sub Import_km()
'Fügt aus allen Dateien des Ordners die Summe aus dem Zellbereich in eine Zelle ein
Dim wbKM As Workbook, wb As Workbook
Dim wksKM As Worksheet
Dim Verzeichnis As Variant, ZellBereich$
Dim i As Integer, ZeileKM As Long
'Neue Arbeitsmappe mit 1 Tabelle anlegen
Set wbKM = Workbooks.Add(Template:=xlWBATWorksheet)
Set wksKM = wbKM.Worksheets(1)
ZeileKM = 1 'Zeile für Spaltentitel in der Tabelle in der Daten eingetragen werden
Verzeichnis = "C:\Test\Daten" 'Hier Verzeichnis anpassen
ZellBereich$ = "K7:K17" 'Zellbereich der summiert wird
'zur Beschleunigung der Codeausführung
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Dateien im Verzeichnis Suchen und abarbeiten
With Application.FileSearch
.NewSearch
.LookIn = Verzeichnis
.FileName = "*.xls"
.SearchSubFolders = False
.MatchTextExactly = True
wksKM.Cells(ZeileKM, 1) = "Dateiname"
wksKM.Cells(ZeileKM, 2) = "Summe-km"
wksKM.Columns(2).NumberFormat = "#,##0" ' Beispiel(deutsch): 2.000
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Application.StatusBar = "Datei " & i & " von " & .FoundFiles.Count & " wird bearbeitet"
'Nächste freie Zeile im Blatt in Spalte A ermitteln
ZeileKM = wksKM.Cells(wksKM.Rows.Count, 1).End(xlUp).Row + 1
Set wb = Workbooks.Open(FileName:=.FoundFiles(i), ReadOnly:=True)
wksKM.Cells(ZeileKM, 1).Value = wb.Name ' oder wb.FullName, wenn mit Verzeichnis
wksKM.Cells(ZeileKM, 2).Value = _
Application.WorksheetFunction.Sum(wb.Worksheets(1).Range(ZellBereich$))
wb.Close savechanges:=False
Next i
Application.StatusBar = False
End If
End With
'Spaltenbreite optimal einstellen
wksKM.Columns.AutoFit
'Beschleunigungseinstellungen zueücksetzen
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Dialogs(xlDialogSaveAs).Show
End Sub

Beliebteste Forumthreads (12 Monate)

Excel Dateien aus Ordner auslesen ..

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel Dateien aus Ordner auslesen ..

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread