Private Sub Zusammenfuehren_Click()
Dim Mappe As String
Dim i As Integer
Mappe = ActiveWorkbook.Name
Range("A2").Select
With Application.FileSearch
.NewSearch
.LookIn = "H:\Test"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i)
Range("E3").Copy
Workbooks(Mappe).Activate
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Next i
End With
End Sub
er macht mir zwar alle excel dateien auf kopiert aber nur die Zelle E3 der Auswertungsdatei und nicht der offenen und er schließt die offenen auch nicht automatisch.