AW: Auslesen von Daten in Excel
Daten
Hallo Daniel,
mit siesen 2 Makro kannst Du alle Exceldateien in einem Ordner im Blatt auflisten und danach einzeln aufrufen. Da muss aber noch das kopieren und einfügen reingebastelt werden.
Sub Write_All_ExcelFiles_in_worksheet()
Application.ScreenUpdating = False
'by Ramses
Dim myFSO As Object
Dim myDrvList, myDrv, mySpace
Dim Dateiform As String, myStr As String
Dim geffile As String
Dim i As Long, totFiles As Long, chkHype As Integer
Dim oldStatus As Variant
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
On Error GoTo myErrHandler
Dateiform = "*.xls"
If Dateiform = "" Then
Application.ScreenUpdating = True
Exit Sub
End If
With Application.FileSearch
' Dein Pfad
.LookIn = "C:\Eigene Dateien" ' hier den Pfad eintragen
.SearchSubFolders = True 'True für Suche in allen Unterverzeichnissen!!
.Filename = Dateiform
If .Execute() > 0 Then
totFiles = .FoundFiles.Count
Application.StatusBar = "Total " & totFiles & " in " & mySpace & " gefunden "
For i = 1 To .FoundFiles.Count
geffile = .FoundFiles(i)
'In Tabelle eintragen
Cells([A65536].End(xlUp).Row + 1, 1) = geffile
ActiveSheet.Hyperlinks.Add Anchor:=Cells([A65536].End(xlUp).Row, 1), Address:=geffile _
, TextToDisplay:=geffile
Selection.Font.ColorIndex = 2
Next i
End If
End With
ErrEntry:
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
MyExit:
Close #1
Exit Sub
myErrHandler:
Select Case err
Case 71
myStr = myStr & "Datenträger nicht bereit"
End Select
Resume ErrEntry
' Liste ist fertig Das Makro copy ruft alle aufglisteten Tabellen auf
Call copy
End Sub
Sub copy()
Application.ScreenUpdating = False
' Fehlermeldungen ausschalten
Application.DisplayAlerts = False
Range("a1").Select
For i = 1 To 90000
zell = ActiveCell.Address
Range(zell).Offset(1, 0).Select
pfadname = ActiveCell
Workbooks.Open Filename:=pfadname
On Error GoTo err
' hier fehlt noch der Rest !!!
ActiveWorkbook.Close
Next i
Exit Sub
err:
Application.Quit
End Sub
Gruß
Marcl