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 al ^^

wenn das ordnermodul nicht konform ist , nimm den ersten coder wieder

ansonsten
ich kann die tage noch eine variante mit Datei oeffnen basteln

obige tips erreichen einen umfang der fehlerferndiagnose erschwert

die tage kommt dann variante 2

gruss nighty

p.s.
ein Schreibfehler und das Ergebnis ist asche :-)

Answer 2

hi all ^^

die 2 variante

gruss nighty

es ist nur der pfad an einer stelle zu ersetzen

Sub DateienLesen()
Call EventsOff
Dim QuellS As Variant, QuellD As Variant
Dim DateiName As String, Dpfad As String
Dim Lzeile As Long, Index As Long
QuellS = Array("H2", "G8", "G10", "G14", "G36")
Dpfad = "D:\Temp\"
DateiName = Dir(Dpfad & "*.*")
Do While DateiName <> ""
Workbooks.Open Filename:=Dpfad & DateiName
Lzeile = ThisWorkbook.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)
ThisWorkbook.ActiveSheet.Range(QuellD(Index)) = Workbooks(DateiName).Worksheets(1).Range(QuellS(Index))
Next Index
Workbooks(DateiName).Close
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 3

hi all ^^

weiteres klärt nur eine Beispieldatei(hochladen(fileupload))

gruss nighty