Zellen aus Dateien in Ordner lesen und ....
16.09.2015 08:35:11
Bastian
1.Es funktioniert ganz gut nur würde ich gerne beim starten des Makros den Ordner der durchsucht werden soll selber auswählen und nicht immer hier in dem Makro ändern
2. Ich würde gerne mehr als nur nach 2 Zeilen suchen .
3. Es soll kein Auswahl Fenster kommen wo das Tabellen Blatt ausgewählt wird sondern immer das 1 Tabellen Blatt nehmen.
4. Die Daten sollen in die Zieldatei nicht in A1 angefangen werden zu schreiben sondern A3 .
Sub searchDir()
Dim fs, f, f1, fc, arr, i
Dim strOrdner As String, strMappe As String
strOrdner = "U:\Prüfprotokolle" ' anpassen
strMappe = "RG"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(strOrdner)
Set fc = f.Files
ReDim arr(fc.Count, 1)
For Each f1 In fc
If Right(f1.Name, 3) = "xls" Or Right(f1.Name, 4) = "xlsx" Then
arr(i, 0) = "='" & strOrdner & "\[" & f1.Name & "]" & strMappe & "'!$D4"
arr(i, 1) = "='" & strOrdner & "\[" & f1.Name & "]" & strMappe & "'!$D5"
End If
i = i + 1
Next
With ThisWorkbook.ActiveSheet
.Range(.Cells(1, 1), .Cells(UBound(arr), 2)) = arr
With .Range(.Cells(1, 1), .Cells(UBound(arr), 2))
.Value = .Value
End With
End With
End Sub
mit freundlichen Grüßen
Bastian