Auslese Funktion

[MgregB]

Hallo zusammen,

ich habe soweit ein Programm geschrieben, dass In einem Ordner eine bestimmte Datei ausliest und von dieser Datei die Zelle A1 in meine Exceltabelle einfügt, ich würde gerne das Programm erweitern, dass er alle Dateien in dem Ordner ausliest und von jeder Datei die Zelle A1 in die Tabelle untereinander ab Zelle A5 einträgt hat jemand eine Tipp für mich?

Hier das Programm, dass ich zum Teil auch aus dem Forum habe:
Private Function GetValue(Pfad, Datei, Blatt, Zelle)
Dim arg As String
 
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
If Dir(Pfad & Datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
 
arg = "'" & Pfad & "[" & Datei & "]" & Blatt & "'!" & Range(Zelle).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
 
End Function

Sub Auslesen()
Dim Pfad As String, Datei As String, Blatt As String, Zelle As String
Pfad = "MeinPfad"
Datei = "MeineDatei.xlsx"
Blatt = "MeinBlatt"
Zelle = "A1"
 
ActiveCell.Value = GetValue(Pfad, Datei, Blatt, Zelle)
 
End Sub




Hoffe jemand kann mir weiterhelfen...


Danke
Gruß
MgregB

[maninweb]

Hallo,

ungestetet, versuche mal das hier ...

Code:

Sub Auslesen()

  Dim Pfad  As String
  Dim Datei As String
  Dim Blatt As String
  Dim Zelle As String
  Dim Zeile As Long
 
  Pfad = "D:\Excel\"
  Blatt = "MeinBlatt"
  Zelle = "A1"
 
  Zeile = 0
  Datei = Dir(Pfad & "*.xlsx")
 
  Do
   
    If Len(Datei) > 0 Then
     
      Zeile = Zeile + 1
     
      ThisWorkbook.ActiveSheet.Cells(Zeile + 4, 1).Value = GetValue(Pfad, Datei, Blatt, Zelle)
     
      Datei = Dir()
     
    End If
   
  Loop While Len(Datei) > 0
 
End Sub

Gruß