912 Aufrufe
Gefragt in Tabellenkalkulation von
Hallo an alle,

ich habe das folgende Problem, dass ich -wie oben beschrieben- aus vielen Excel Dateien immer aus einem bestimmten Arbeitsblatt Namens "temperature" den ganzen Inhalt von C1 an sammeln möchte.

Dabei sollen die Daten hintereinander, beginnend bei C1 fortgeschrieben werden, also aus der ersten Datei alles von C bis beispielhaft XY, aus der zweiten Datei beginnend bei XZ bis ACA usw

Bisher habe ich leider keine Lösungen finden können und würde mich über Hilfe sehr freuen.

Viele Grüße

23 Antworten

0 Punkte
Beantwortet von
Hallo Mark84 .-)

Ein Beispel!

Gruss Nighty

Sub DateienLesen()
Dim DateiName As String
Dim Qordner As Variant
Qordner = CreateObject("Shell.Application").BrowseForFolder(0, "Ordner auswählen", &H1000, 17).items().Item().Path & "\"
DateiName = Dir(Qordner & "*.xls")
Lzeile = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row + 1
Do While DateiName <> ""
Lspalte = Lspalte + 1
Cells(Lzeile, Lspalte) = ExecuteExcel4Macro("'" & Qordner & "[" & DateiName & "]temperature" & "'!" & Range("C1").Address(, , xlR1C1))
DateiName = Dir
Loop
End Sub
0 Punkte
Beantwortet von
Hallo Community .-)

Korrigiert!

Gruss Nighty

Sub DateienLesen()
Dim Lzeile As Long, Lspalte As Long
Dim DateiName As String
Dim Qordner As Variant
Qordner = CreateObject("Shell.Application").BrowseForFolder(0, "Ordner auswählen", &H1000, 17).items().Item().Path & "\"
DateiName = Dir(Qordner & "*.xls")
Lzeile = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row + 1
Do While DateiName <> ""
Lspalte = Lspalte + 1
Cells(Lzeile, Lspalte) = ExecuteExcel4Macro("'" & Qordner & "[" & DateiName & "]temperature" & "'!" & Range("C1").Address(, , xlR1C1))
DateiName = Dir
Loop
End Sub
0 Punkte
Beantwortet von
Hallo Community .-)

5 Zeile noch die Endung anpassen!

DateiName = Dir(Qordner & "*.xls")


Eventuelle Ergänzung!
Begin ab Spalte 2,zum Anfang des Codes einfügen
Lspalte = 1


Gruss Nighty
0 Punkte
Beantwortet von
Hallo Nighty,

vielen Dank für deine Hilfe! Leider funktioniert es noch nicht. Wenn ich den Code einkopiere und dann ausführe, kann ich wie gewünscht den Ordner auswählen in dem sich die Dateien befinden, leider kommen nach der Bestätigung nur drei Zellen mit: #BEZUG! #BEZUG! 0

Verstehst du warum?

Gruß Mark
0 Punkte
Beantwortet von
Hallo Mark .-)

Richtiger Tabellennamen ?
In der Zeile!
Cells(Lzeile, Lspalte) = ExecuteExcel4Macro("'" & Qordner & "[" & DateiName & "]temperature" & "'!" & Range("C1").Address(, , xlR1C1))

Gruss Nighty
0 Punkte
Beantwortet von
Also das Tabellenblatt heißt temperature. Ist aber das zweite Tabellenblatt. Hat das was damit zu tun? Oder könnte es was damit zu tun haben, dass ich beim manuellen öffnen der Datei immer aufgefordert werde:

"Das Dateiformat und die Dateierweiterung von ´Kalibr.....xls´passen nicht zueinander. Möglicherweise ist die Datei beschädigt oder nicht sicher. Sie sollten sie nicht öffnen, wenn Sie ihrer Quelle nicht vertrauen. Möchten Sie die Datei trotzdem öffnen? Ja Nein Hilfe"

Das bestätige ich mit Ja und dann funktioniert meiner Meinung nach alles.

:(

Ich habe es nun auch einmal mit zwei eigenen Excel-Dateien ausprobiert und dem ersten Tabellenblatt den Namen temperature gegeben und beim Verwenden des Makros in einer neuen leeren Datei in A1 wird in A2 "0" und in B2 "#BEZUG!" eingetragen.

Gruß Mark
0 Punkte
Beantwortet von
Hallo Mark .-)

Ich mach das dann anders!
Ein/Zwei Tage

Gruss Nighty
0 Punkte
Beantwortet von
Hallo Nighty,

vielen vielen Dank für deine Mühe. Was mir heute Nacht noch eingefallen ist: Könnte es was damit zu tun haben, dass ich sowoh Zellen mit Text, Zahlen Datum und Uhrzeit habe? Also nicht alles in einer Zelle sondern in einer Zelle jeweils eines.

Gruß Mark
0 Punkte
Beantwortet von
Hallo Mark .-)

Probier mal!

Gruss Nighty

Es wird das Worksheets("temperature") angesprochen!

Diese zwei Zeilen sind im ersten Modul anzupassen
!code]Dpfad = "J:\Temp\"[/code]
Deindung = "*.xls"



Sub DateienLesen()
Call EventsOff
Dim DateiName As String
Dim Lzeile As Long, Lspalte As Long
Dsuche = Range("A2")
Dpfad = "J:\Temp\"
Deindung = "*.xls"
DateiName = Dir(Dpfad & Deindung)
Lzeile = ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row + 1
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=Dpfad & DateiName
If Workbooks(DateiName).Worksheets("temperature").Range("C1") <> "" Then
Lspalte = Lspalte + 1
ThisWorkbook.ActiveSheet.Cells(Lzeile, Lspalte) = Workbooks(DateiName).Worksheets("temperature").Range("C1")
End If
Workbooks(DateiName).Close SaveChanges:=False
End If
DateiName = Dir
Loop
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
0 Punkte
Beantwortet von
Hallo Mark .-)

Die Zeile kann noch gelöscht werden!
Dsuche = Range("A2")


Gruss Nighty
...