Hilfe, das sind zu viele Dateien

Question

Hallo, wer kann helfen ?
habe ca. 300 einzelne Excel-Dateien.
In jeder Datei steht in der gleichen Zelle ein bestimmter Wert, z.B. 1A=Name, 1B=Telefonnummer.
Möchte nun ein neues Excelblatt erstellen, dass alle Zellen untereinander beinhaltet.

Weiß jemand Rat?

Danke im vorraus

Gruss HPHanke

Answer 1

hi all ^^

ein beispiel,bei dem der pfad anzupassen waere. wie auch eventuell worklsheetindex

gruss nighty

Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Temp\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
Workbooks(DateiName).Worksheets(1).Range("A1:B1").Copy _
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)
Workbooks(DateiName).Close SaveChanges:=True
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

Answer 2

Hallo
recht vielen Dank!


sieht wie VB aus, muss ich gleich mal ausprobieren.


Danke

Answer 3

hi all ^^

das bitte noch loeschen :-)

SaveChanges:=True

von der zeile

Workbooks(DateiName).Close SaveChanges:=True

gruss nighty

Answer 4

Hallo nighty,
bin begeistert. Nachdem ich die Hürden mit dem Macro aktivieren überwunden hatte, funzte es auch gleich schon los.

Vielen Dank nochmals.


PS: Was bedeutet die anweisung:
SaveChanges:=True


Gruss hphanke

Answer 5

Hallo nighty,
Habe noch eine Kleinigkeit.

Es kommt eine Warnmeldung bei einigen Tabelle hoch, dass dort Verweise vorhanden sind, die ungültig sind.
Kann mann dieses Meldung unterdrücken ?

Die Meldung wird bei der folgenden Anweisung
Workbooks.Open Filename:="C:\Temp\" & DateiName
ausgelöst.

Kann mann diese Melung unterdrücken ?

Gruß hphanke

Answer 6

hi all ^^

dann so .-)

gruss nighty

Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Temp\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
Workbooks(DateiName).Worksheets(1).Range("A1:B1").Copy _
ThisWorkbook.Worksheets(1).Range("A" & ThisWorkbook.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1)
Workbooks(DateiName).Close
End If
DateiName = Dir
Loop
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Answer 7

hi hphanke ^^

SaveChanges:=True

Die Datei wird gespeichert,was bei deiner problemstellung nicht gebraucht wird

gruss nighty :-)