VBA Makros Excel - aus mehreren Excel Mappen bestimmte Zellen rausfiltern

Question

Hallo alle zusammen,

ich habe in einem Ordner ca. 500 Excel-Files mit den Endungen .xlx .xlsx .xlsm

Alle Excel-Files sind gleich gebaut und besitzen nur ein Tabelleblatt. Aus diesen Excel-Files brauche ich die Felder H2, G8, G10, G14, G36. Diese Zelleninhalte sollen dann in ein neues Excel-File überführt werden.

Die überführten Zellen sollen im neuen Excel-File in bestimmte Zellen rein:
Beispielsweise: H2 in B3, G8 in C3, G10 in D3, G14 in E3 usw. also in einer Zeile
Dann in der neuen Zeile die nächsten Einträge aus dem nächsten Excel file:
H2 in B4, G8 in C4, G10 in D4 ...

Wäre sowas möglich? Ich habe absolut null Ahnung wie ich das machen soll. Ich benutze Excel 2007 falls das wichtig ist.

Kann mir da jemand helfen bitte?

Liebe Grüße tice

Answer 1

hi all ^^

wie gewünscht

gruss nighty

pfad waere anzupassen

in dem ordner deiner Wahl sollten sich nur die benötigten Dateien befinden

Sub DateienLesen()
Call EventsOff
Dim QuellS As Variant, QuellD As Variant
Dim DateiName As String
Dim Lzeile As Long, Index As Long
QuellS = Array("H2", "G8", "G10", "G14", "G36")
DateiName = Dir("D:\Temp\*.*")
Do While DateiName <> ""
Lzeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
QuellD = Array("B" & Lzeile, "C" & Lzeile, "D" & Lzeile, "E" & Lzeile, "F" & Lzeile)
For Index = 0 To UBound(QuellS)
Range(QuellD(Index)) = ExecuteExcel4Macro("'D:\Temp\" & "[" & DateiName & "]Tabelle1" & "'!" & Range(QuellS(Index)).Address(, , xlR1C1))
Next Index
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

Answer 2

hi all ^^

der Worksheetname Tabelle1 waere noch anzupassen

sollte der Name nicht immer gleich sein muessten die Dateien geöffnet werden

gruss nighty

Answer 3

Huhuuu,

dankeschön für deine Antwort. :)

So erstmal ne Dumme Frage: Den Code füge ich doch in meinem Excel-File, die ich dann am Ende als Endergebnis haben will oder? Also im VBA unter beispielsweise Mappe1.xlsm in einem Modul?

In den Dateien sind alle Worksheetnamen gleich. Ich bekomme bisher nur eine leere Ausgabe :(

Vielen Dank für deine Bemühungen.
Lg tice

Answer 4

hi all ^^

in dieser zeile den namen Tabelle1 eventuell aendern und den pfad "'D:\Temp\"
Range(QuellD(Index)) = ExecuteExcel4Macro("'D:\Temp\" & "[" & DateiName & "]Tabelle1" & "'!" & Range(QuellS(Index)).Address(, , xlR1C1))

in dieser zeile auch den pfad anpassen "'D:\Temp\"
DateiName = Dir("D:\Temp\*.*")

gruss nighty

Answer 5

hi all ^^

das makro gehört in ein allgemeines modul

gruss nighty

Answer 6

hi all ^^

geschützte Bereiche sind nicht berücksichtigt

verbundene zellen sind nicht berücksichtigt

gruss nighty

Answer 7

hi all ^^

sollte es nun immer noch nicht funktionieren lade eine quell wie ziel Datei hoch z.b. bei fileupload
und poste den link dann hier im forum
aber in xls Format das beim speichern zur Auswahl steht

gruss nighty

Answer 8

hi all ^^

nun mit ordnerauswahl

waere noch der name Tabelle1 anzupassen

gruss nighty

Sub DateienLesen()
Call EventsOff
Dim QuellS As Variant, QuellD As Variant
Dim DateiName As String, OrdPos As String
Dim Lzeile As Long, Index As Long
QuellS = Array("H2", "G8", "G10", "G14", "G36")
OrdPos = OrdnerAuswahl
DateiName = Dir(OrdPos & "*.*")
Do While DateiName <> ""
Lzeile = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1
QuellD = Array("B" & Lzeile, "C" & Lzeile, "D" & Lzeile, "E" & Lzeile, "F" & Lzeile)
For Index = 0 To UBound(QuellS)
Range(QuellD(Index)) = ExecuteExcel4Macro("'" & OrdPos & "[" & DateiName & "]Tabelle1" & "'!" & Range(QuellS(Index)).Address(, , xlR1C1))
Next Index
DateiName = Dir
Loop
Call EventsOn
End Sub

Function OrdnerAuswahl() As String
On Error GoTo FehlerRoutine
Dim AppShell As Object
Dim BrowseDir As Variant
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
OrdnerAuswahl = BrowseDir.items().Item().Path & "\"
FehlerRoutine:
End Function

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

Answer 9

Hallöchen nochmal,

#BEZUG bekomme ich jetzt ales Fehlermeldung?

Was bedeutet das?

Liebe Grüße
tice

Answer 10

hi all

wie ist der Name des worksheets ?
sind geschützte Bereiche und verbundene zellen ausgeschlossen ?
oder auch geschützte ordner bzw Dateien ?

mit f8 teste mal im vbeditor in einzelschritten ob die orderfunction ausgefuehrt wird
mit der mouse dann auf OrdPos,dir wird dann der pfad angezeigt
dient der kontrolle ob das modul konform zu deiner Excel variante ist
ist der pfad korrekt dann obige tips weiter verfolgen

gruss nighty