Excel und VBA: Formeln, Programmierung, Lösungen

StandardModule: Modul1

Sub ImportOthers()
   Dim fs As FileSearch
   Dim lRow As Long
   Dim iCounter As Integer
   Application.ScreenUpdating = False
   Set fs = Application.FileSearch
   lRow = 1
   With fs
      .Filename = "*.xls"
      .LookIn = Range("B1").Value
      .Execute
      For iCounter = 1 To .FoundFiles.Count
         Cells(lRow, 1).Value = .FoundFiles(iCounter)
         lRow = lRow + 1
         Workbooks.Open .FoundFiles(iCounter)
         Range("other").Copy ThisWorkbook.Worksheets(1).Cells(lRow, 1)
         lRow = lRow + Range("other").Rows.Count + 2
         ActiveWorkbook.Close savechanges:=False
      Next iCounter
   End With
   Application.ScreenUpdating = True
End Sub

    

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Kopieren