Hallo Leute,
ich brauche mal wieder eure Hilfe. Ich hoffe ihr könnt mir weiterhelfen.
Mein Problem: Ich habe ca. 100 Exceldateien alle gleich aufgebaut in einem Ordner. Nun möchte mit Hilfe eines Markos den Bereich A3:EV146 aller Dateien auslesen und in einer neuen Arbeitsmappe untereinander einfügen. Ich arbeite mir Execl 97.
Habe auch schon im Internet geschaut, doch da fand nur etwas für bestimmte Zellen.
Ich bedanke mich schon mal in Vorraus für eure Mühen
Mein Problem: Ich habe ca. 100 Exceldateien alle gleich
aufgebaut in einem Ordner. Nun möchte mit Hilfe eines Markos
den Bereich A3:EV146 aller Dateien auslesen und in einer neuen
Arbeitsmappe untereinander einfügen. Ich arbeite mir Execl 97.
Hallo Sunny,
Anrede, Name, Gruß o.ä. wird hier gern gesehen.
Diese 100 Dateien, welche namen haben die, irgendwas fortlaufendes wie einen Index o.ä.?
soill zu jeder Eintragung der Dateiname der Quelldatei geschrieben werden?
Gruß
Reinhard
Hallo Reinhard
Also die Dateien fangen alle mit einem Datum an (2010-12-24-)
In der Datei muss nicht der Name der Quelldatei geschreiben werden.´Da das Datum in der Spalte A ist erkennt man die Daten wieder
Lieben Gruß
Sunny
Also die Dateien fangen alle mit einem Datum an (2010-12-24-)
In der Datei muss nicht der Name der Quelldatei geschreiben
werden.´Da das Datum in der Spalte A ist erkennt man die Daten
wieder
Hallo Sunny,
Alt+F11, Einfügen–Modul, Code reinkopieren.
Im Code den Pfad anpassen sowie die beiden Blattnamen „Tabelle1“,
Editor schliessen.
In Excel Alt+F8, Makro „Einlesen“ ausführen lassen…
Option Explicit
Sub Einlesen()
Dim F As Long, Zei As Long, wks1 As Worksheet
Const Pfad As String = "c:\test"
Set wks1 = ThisWorkbook.Worksheets("Tabelle1")
Zei = 3
With Application.FileSearch
.LookIn = Pfad
.SearchSubFolders = False
.Filename = "????-\*.xls"
If .Execute() \> 0 Then
For F = 1 To 2 '.FoundFiles.Count
Workbooks.Open .FoundFiles(F)
ActiveWorkbook.Worksheets("Tabelle1").Range("A3:EV146").Copy \_
Destination:=wks1.Cells(Zei, 1)
Zei = Zei + 144
Next F
Else
MsgBox "keine Dateien"
End If
End With
End Sub
Gruß
Reinhard
Hallo Reinhard
Danke für deine Antwort. Habe so eben das Marko ausprobiert, doch leider zeigt das Programm mir beim filename einen Fehler an. Habe schon versucht den filename anzupassen doch leider hatte ich keinen Erfolg.
Woran kann das liegen?
Lieben Gruß
Dennis
Danke für deine Antwort. Habe so eben das Marko ausprobiert,
doch leider zeigt das Programm mir beim filename einen Fehler
an. Habe schon versucht den filename anzupassen doch leider
hatte ich keinen Erfolg.
Hallo Dennis,
welcher Fehler? Code ist getestet mit XL2000.
Nachfolgend neuer Code, der schließt die Mappen auch wieder.
Gruß
Reinhard
Option Explicit
Sub Einlesen()
Dim F As Long, Zei As Long, wks1 As Worksheet
Const Pfad As String = "c:\test"
Set wks1 = ThisWorkbook.Worksheets("Tabelle1")
Zei = 3
On Error GoTo hell
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = Pfad
.SearchSubFolders = False
.Filename = "????-\*.xls"
If .Execute() \> 0 Then
For F = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(F)
ActiveWorkbook.Worksheets("Tabelle1").Range("A3:EV146").Copy \_
Destination:=wks1.Cells(Zei, 1)
Zei = Zei + 144
ActiveWorkbook.Close savechanges:=False
Next F
Else
MsgBox "keine Dateien"
End If
End With
hell:
If Err.Number 0 Then MsgBox Err.Number & vbCr & Err.Description
Application.ScreenUpdating = True
End Sub
Hallo Reinhart
Erstmal entschulde ich mich, für die späte Antwort. Ich konnte das Makro vorher nicht ausprobieren, da ich sehr viel zu erledigen hatte.
Also das Marko funktioniert super und macht genau das was es soll.
Vielen lieben Dank für deine erneute Hilfe. Ich wünsche dir noch einen schönen Tag
Lieben Gruß
Dennis