den folgenden Code von Josef Ehrensberger habe ich in der Recherche gefunden. Er kopiert aus allen Mappen, die sich in einem vorgegebenen Ordner befinden, die Zeile 2 der Tabelle1 und das funktioniert auch bestens.
Ich bräuchte allerdings eine (vielleicht) kleine Änderung, und zwar sollte nicht nur die Zeile 2 kopiert werden, sondern ab Zeile 1 alle bis zur letzten benutzten Zeile.
Hier noch der Code:
Option Explicit
Public Sub ReadFromFile_ADO()
Dim objFS As FileSearch
Dim strPath As String
Dim intIndex As Integer, intC As Integer
Dim varValues As Variant
Dim lngNext As Long
On Error GoTo ErrExit
GetMoreSpeed
lngNext = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1 'im Original "Daten"
If lngNext 0 Then
For intIndex = 1 To .FoundFiles.Count
With ExcelTable(.FoundFiles(intIndex), "Tabelle1", "A1:IV2")
varValues = .GetRows
.Close
End With
For intC = 0 To UBound(varValues)
If IsNull(varValues(intC, 0)) Then varValues(intC, 0) = ""
Next
With Sheets("Tabelle1") 'im Original "Daten"
.Range(.Cells(lngNext, 1), .Cells(lngNext, UBound(varValues) + 1)) = Application. _
Transpose(varValues)
End With
lngNext = lngNext + 1
Next
End If
End With
ErrExit:
If Err Then
MsgBox Err.Description & vbLf & Err.Number, 64, "Fehler"
Err.Clear
End If
GetMoreSpeed 0
Set objFS = Nothing
End Sub
Public Function ExcelTable(ByRef Path As String, ByRef Table As String, ByRef SourceRange As _
String) As Object
Dim SQL As String
Dim Con As String
On Error Resume Next
SQL = "select * from [" & Table & "$" & SourceRange & "]"
Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Extended Properties=Excel 8.0;" _
& "Data Source=" & Path & ";"
Set ExcelTable = CreateObject("ADODB.Recordset")
ExcelTable.Open SQL, Con, 1, 3
End Function
Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
With Application
If Modus = 1 Then
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = -4135
.Cursor = xlWait
Else
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = -4105
.Cursor = xlDefault
End If
End With
End Sub
Besten Dank im voraus und Servus, Walter