Excel-Dateien auslesen (VBA)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Gaidin,
Erstelle eine Schleife für die Anzahl der zu öffnenden Dateien. Lege Dir ein paar Variablen für die verschiedenen Dateien an. Die läßt Du dann mit den Pfadangaben füllen. Bsp.:
Pfad = Application.GetOpenFilename("Ecxeldateien (*.xls), *.xls", 1, "Datei wählen", "Öffnen", False)
oder trage die Pfade per Hand ein.
dann wechsle in das betreffende Arbeitsblatt. Mit einer For Each Schleife läßt Du die Bereiche einlesen. Die Zeilenanzahl kannst Du notfalls über eine vorgelagerte Schleife ermitteln lassen. Bsp.:
If activecell = "" then ...
Du kannst danach ein Array mit den Werten füllen. Wechsle dann in Deine neue Datei, in das richtige Arbeitsblatt und lies, wieder über eine Schleife, das Array aus und schreibe die Daten in die neue Tabelle. Ermittle´die letzte Zelladresse und beginne beim nächsten Vorgang dort mit dem Schreiben. Vorgang sooft wiederholen lassen, bis alle alten Dateien ausgelesen wurden.
Da ich bei Dir lese VBA gut, dürfte das für Dich weiter kein Problem sein.
Ciao, Ralf

Hmm,
mein Problem liegt wo anders. Ich habe das Auslesen mit Application.Filesearch gelöst. Was mir eigentlich fehlt ist, dass der auzulesende Range dynamisch ermittelt wird. Ich habe da bisher ohne richtige Lösung dran rumgefuhrwerkt: Hier der Code:
******************************************************


Sub Daten_lesen()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long
Dim strend As String
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "D:\Daten\"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i))
strend = Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).Offset(0, 1)
Set sourceRange = mybook.Worksheets(1).Range("A2").End(strend)
With sourceRange
Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
mybook.Close
rnum = rnum + a
Next i
End If
End With
Application.ScreenUpdating = True
End Sub

*******************************************************
Das Problem liegt in diesem Bereich:
strend = Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).Offset(0, 1)
Set sourceRange = mybook.Worksheets(1).Range("A2").End(strend)
Ich finde einfach nicht die letzte Zelle des Ranges.
Weisst du da weiter?
Gaidin

Sub Daten_lesen() Dim basebook As Workbook Dim mybook As Workbook Dim sourceRange As Range Dim destrange As Range Dim rnum As Long Dim i As Long Dim a As Long Dim rngend As String Application.ScreenUpdating = False With Application.FileSearch .NewSearch .LookIn = "D:\Daten\" .SearchSubFolders = True .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then Set basebook = ThisWorkbook rnum = 1 For i = 1 To .FoundFiles.Count Application.DisplayAlerts = False Set mybook = Workbooks.Open(.FoundFiles(i)) rngend = Range("m65536").End(xlUp).Address Set sourceRange = mybook.Worksheets(1).Range("A2", rngend) a = sourceRange.Rows.Count With sourceRange Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value mybook.Close rnum = rnum + a Next i End If End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread