Daten aus mehreren Excel-Dateien sammeln und in einer anderen Datei darstellen

Question

Hallo zusammen!
Ich würde mich sehr freuen, wenn mir jemand hierzu helfen kann.

Ich möchte per Knopfdruck aus allen meinen Datein im xlsm-Format (im gleichen Verzeichnis, aber mit unterschiedlichen Namen im xlsm-Format) bestimmte Zellen kopiert bekommen und diese in einer anderen Datei auflisten.

Beispiel:
Die Tabellen enthalten alle in der gleichen Zelle (B2) einen Namen.
Ebenso enthalten sie alle in der gleichen Zelle (D4) einen Zahlenwert.
Die Tabellenblätter heißen alle standardmäßig "Tabelle1".

Ich möchte jetzt in die neue Datei ("Sammlung.xlsm") die Daten der anderen Datein übertragen:
Aus der alphabetisch ersten Tabelle sollen Zellen B2 und D4 in die Datei "Sammlung.xlsm" in die Zellen B2 und C2 kopiert werden.
Die nachfolgende Datei soll dann seine Zellen B2 und D4 in die neue Datei "Sammlung.xlsm" in die Zellen B3 und C3 übertragen.
Und so weiter...

Ich bedanke mich für die Mühe der Teilnehmer, die dieses Anliegen lösen möchten!
ilkin

Answer 1

Hi hydroxy333

vielleicht so !

gruss nighty

Erstellung einer neuen mappe

zellen B2 + D4 werden ausgelesn von allen Dateien im angegebenen Verzeichnis und ab B2 + C3 dargestellt

Datei mit dem namen Sammlung gespeichert und geschlossen

Zeilen die angepasst werden müssen,sind mit Kommentar versehen

Sub DateienLesen()
Dim ZellPos As Variant
Dim DateiName As String, DeinPfad As String
DeinPfad = "J:\Temp\" 'Pfad anpassen
DateiName = Dir(DeinPfad & "*.xls") 'Dateiendung anpassen
Workbooks.Add
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Worksheets("Tabelle1").Cells(Worksheets("Tabelle1").Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = _
ExecuteExcel4Macro("'" & DeinPfad & "[" & DateiName & "]Tabelle1" & "'!" & Range("B2").Address(, , xlR1C1))
Worksheets("Tabelle1").Cells(Worksheets("Tabelle1").Cells(Rows.Count, 3).End(xlUp).Row + 1, 3) = _
ExecuteExcel4Macro("'" & DeinPfad & "[" & DateiName & "]Tabelle1" & "'!" & Range("D4").Address(, , xlR1C1))
End If
DateiName = Dir
Loop
ActiveWorkbook.SaveAs Filename:=DeinPfad & "Sammlung.xls" 'Dateiendung anpassen
ActiveWindow.Close
End Sub

Answer 2

hi all ^^

diese zeile

Dim ZellPos As Variant

kann gelöscht werden,hatte ich vergessen!

gruss nighty

Answer 3

hi all :-)

Besser anpassbae!

Gruss nighty

Sub DateienLesen()
Dim Qzelle1 As String, Qzelle2 As String, Zzelle1 As String, Zzelle2 As String
Dim DateiName As String, DeinPfad As String
DeinPfad = ThisWorkbook.Path & "\" 'Pfad anpassen(zur zeit Pfad der Datei)
Qzelle1 = "B2" 'Erste QuellZelle
Qzelle2 = "D4" 'Zweite QuellZelle
Zzelle1 = "B2" 'Erste ZielZelle
Zzelle2 = "C2" 'Zweite ZielZelle
DateiName = Dir(DeinPfad & "*.xls") 'Dateiendung anpassen
Workbooks.Add
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Worksheets("Tabelle1").Cells(Worksheets("Tabelle1").Cells(Rows.Count, Range(Zzelle1).Column).End(xlUp).Row + 1, Range(Zzelle1).Column) = _
ExecuteExcel4Macro("'" & DeinPfad & "[" & DateiName & "]Tabelle1" & "'!" & Range(Qzelle1).Address(, , xlR1C1))
Worksheets("Tabelle1").Cells(Worksheets("Tabelle1").Cells(Rows.Count, Range(Zzelle1).Column).End(xlUp).Row, Range(Zzelle2).Column) = _
ExecuteExcel4Macro("'" & DeinPfad & "[" & DateiName & "]Tabelle1" & "'!" & Range(Qzelle2).Address(, , xlR1C1))
End If
DateiName = Dir
Loop
ActiveWorkbook.SaveAs Filename:=DeinPfad & "Sammlung.xls" 'Dateiendung anpassen
ActiveWindow.Close
End Sub

Answer 4

Hallo,
danke!
Die Zellen werden prima ausgelesen.

Der Name erscheint so wie es sein soll (in Zelle B2).
Irgendwie muss ich noch hinbekommen, dass der richtige Zahlenwert (aus D4) auch auf dem Blatt "Sammlung" erscheint.

Genauer:
Die QZelle D4 zeigt einen Punktewert (zB "8 P") auf Grundlage einer verschachtelten "Wenn-Beziehung".
Konkret: " =WENN(N3>95;"15 P";WENN(N3>90;"14 P";WENN(N3>85;"13 P"; usw... "

Die ZZelle gibt dann in entsprechender Zelle folgendes aus:
QZelle D4 beinhaltet ´8 P´
ZZelle D2 zeigt `8:00 PM´ -- stelle ich das Format "Standard" ein, so steht da ´0,8333333´

Oder:
QZelle D4 beinhaltet ´11 P´
ZZelle D3 zeigt ´11:00 PM´, bzw. ´0,9583333´

Seltsamerweise werden gelegentlich Zellen richtig dargestellt: Aus 13 P wird dann 13 P ...

Der Dezimalbruch kann dabei nicht der Prozentwert sein, denn 0,9583333 würde 15 P entsprechen... ich weiß nicht, wie diese Zahl zustande kommt.

Woran liegt das?

Answer 5

hi all ^^

Zelle oder genutzten Bereich als Text Formatieren!

Genutzter Bereich selectieren/rechtsclicl/Zellen formatieren

Gruss Nighty

Answer 6

Hallo,

die Zellen habe ich als Text formatiert.

Dennoch das gleiche Ergebnis.

hier ein Ausszug aus Sammlung.xls

0,958333333
13 P
0,958333333
0,833333333
0,833333333
0,75

Seltsam seltsam...

Answer 7

hi all ^^

dann probier mal so,mir voriger Formatierung

gruss nighty

Sub DateienLesen()
Dim Qzelle1 As String, Qzelle2 As String, Zzelle1 As String, Zzelle2 As String
Dim DateiName As String, DeinPfad As String
DeinPfad = ThisWorkbook.Path & "\" 'Pfad anpassen(zur zeit Pfad der Datei)
Qzelle1 = "B2" 'Erste QuellZelle
Qzelle2 = "D4" 'Zweite QuellZelle
Zzelle1 = "B2" 'Erste ZielZelle
Zzelle2 = "C2" 'Zweite ZielZelle
DateiName = Dir(DeinPfad & "*.xls") 'Dateiendung anpassen
Workbooks.Add
Worksheets("Tabelle1").Range(Cells(1, Range(Zzelle1).Column), Cells(Rows.Count, Range(Zzelle1).Column)).NumberFormat = "@"
Worksheets("Tabelle1").Range(Cells(1, Range(Zzelle2).Column), Cells(Rows.Count, Range(Zzelle2).Column)).NumberFormat = "@"
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Worksheets("Tabelle1").Cells(Worksheets("Tabelle1").Cells(Rows.Count, Range(Zzelle1).Column).End(xlUp).Row + 1, Range(Zzelle1).Column) = _
ExecuteExcel4Macro("'" & DeinPfad & "[" & DateiName & "]Tabelle1" & "'!" & Range(Qzelle1).Address(, , xlR1C1))
Worksheets("Tabelle1").Cells(Worksheets("Tabelle1").Cells(Rows.Count, Range(Zzelle1).Column).End(xlUp).Row, Range(Zzelle2).Column) = _
ExecuteExcel4Macro("'" & DeinPfad & "[" & DateiName & "]Tabelle1" & "'!" & Range(Qzelle2).Address(, , xlR1C1))
End If
DateiName = Dir
Loop
ActiveWorkbook.SaveAs Filename:=DeinPfad & "Sammlung.xls" 'Dateiendung anpassen
ActiveWindow.Close
End Sub

Answer 8

Hey nighty!
Danke für deinen Einsatz.

Jetzt kommt bei Ausführung eine Messagebox mit dem Inhalt "400", was laut Excel-Hilfe wohl fogendes bedeutet:

"
Formular wird bereits angezeigt und kann daher nicht gebunden dargestellt werden (Fehler 400)
Zusatzinfo

Sie können die Show-Methode nicht verwenden, um ein bereits sichtbares Formular gebunden anzuzeigen. Dieser Fehler hat folgende Ursache und Lösung:

Sie haben versucht, Show mit dem Wert 1 - vbModal für das Stil-Argument bei einem bereits eingeblendetem Formular zu verwenden.
Verwenden Sie entweder die Unload-Anweisung oder die Hide-Methode in dem Formular, bevor Sie versuchen, dieses als gebundenes Formular anzuzeigen.
"

Answer 9

Achso:
Und Excel öffnet ne neue leere Mappe

Answer 10

Huch?!

In einem anderen Ordner hats jetzt wunderbar geklappt...

Ich versuche herauszufinden, warum es in einem Ordner funktioniert, in dem anderen aber nicht.