mehrere Excel-Datei auswerten & Werte in einer Tab

Hallo liebe Forumer,
ich habe ein recht eiliges Problem, kann es aber selbst nicht lösen,
da mir das Fachwissen dazu fehlt. Mir wurde hier schon so gut geholfen.
Deswegen wende ich mich nochmal an euch Profis.
Problemstellung:
Ich habe ca. 100 Exceldateien mit je 4 Arbeitsmappen.
Nun möchte ich gerne alle Dateien öffnen und immer aus der 1sten Mappe Daten auslesen und diese in einer neuen Tabelle als Zusammenfassung speichern.
Der Aufbau der Mappe1 ist im Grunde immer gleich. Es gibt jeweils 3 Daten die ich auswerten möchte. In Zelle A17 steht ein String, in E17 steht ein String. Das Größe Problem ist der 3te Wert. Dieser befindet sich jeweils in verschiedenen Zellen. Aber immer in der Range E18:AV50. In dieser Range gibt es auch immer nur einen Wert(String) der auszulesen wäre. Eine Musterdatei könnte ich frühstens morgen dazufügen...Sorry.
Evtl. habt ihr eine gute Lösung für mein Problem parat.
Danke euch vorab.
Gruß
Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andreas,
hier das Grundgerüst für ein Auswerte Makro.
Der Abschnitt für die variable Zelle muss ggf. angepasst werden.
LG
Franz


'Code in einem allgemeinen Modul
Sub Daten_einlesen()
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim wkbQuelle As Workbook, wksQuelle As Worksheet, ZeiZ As Long
Dim varFiles As Variant, varDatei As Variant
Dim rngZelle As Range
Dim StatusCalc As Long
Dateiauswahl:
With Application.FileDialog(msoFileDialogOpen)
.Title = "Bitte auszuwertende Dateien auswählen - Mehrfachauswahl ist möglich"
.AllowMultiSelect = True
If .Show = -1 Then
Set varFiles = .SelectedItems
Else
GoTo Beenden
End If
End With
'Makrobremsen lösen
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
'Zieldatei anlegen und vorbereiten
If wkbZiel Is Nothing Then
Set wkbZiel = Application.Workbooks.Add(Template:=xlWBATWorksheet)
Set wksZiel = wkbZiel.Worksheets(1)
With wksZiel
ZeiZ = 1
'Spaltentitel
.Cells(ZeiZ, 1).Value = "Zelle A17"
.Cells(ZeiZ, 2).Value = "Zelle E17"
.Cells(ZeiZ, 3).Value = "Zelle E18-AV50"
.Cells(ZeiZ, 4).Value = "Dateiname"
End With
End If
'gewählte Dateien abarbeiten
For Each varDatei In varFiles
Set wkbQuelle = Application.Workbooks.Open(Filename:=varDatei, ReadOnly:=True)
Set wksQuelle = wkbQuelle.Sheets(1)
With wksQuelle
ZeiZ = ZeiZ + 1
wksZiel.Cells(ZeiZ, 1).Value = .Range("A17").Value
wksZiel.Cells(ZeiZ, 2).Value = .Range("E17").Value
'Zelle mit Wert in E18:AV50 suchen - diesem Abschnitt ggf. anpassen
Set rngZelle = Nothing
With .Range("E18:AV50")
'letzte Zelle mit Inhalt im Bereich
Set rngZelle = .Find(what:="*", After:=.Range("A1"), LookIn:=xlValues, _
lookat:=xlWhole, searchdirection:=xlPrevious)
End With
'Wert aus Zelle ggf. in Zielblatt eintragem
If Not rngZelle Is Nothing Then
wksZiel.Cells(ZeiZ, 3).Value = rngZelle.Value
End If
wksZiel.Cells(ZeiZ, 4).Value = wkbQuelle.Name
End With
wkbQuelle.Close savechanges:=False
Next
'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
If .Calculation  StatusCalc Then .Calculation = StatusCalc
.EnableEvents = True
End With
If MsgBox("weitere Dateien einlesen?", vbYesNo, "Werte aus Dateien einlesen") = vbYes _
Then GoTo Dateiauswahl
'Zieltabelle formatieren
With wksZiel
.Columns.AutoFit
'Spalte mit Dateiname wieder löschen
'.Columns(4).Delete
End With
Beenden:
End Sub

Beliebteste Forumthreads (12 Monate)

mehrere Excel-Datei auswerten & Werte in einer Tab

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

mehrere Excel-Datei auswerten & Werte in einer Tab

4 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)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread