Convert VBA Application.Filesearch Copy/Paste

Mtaylorlc

New Member
Joined
Mar 31, 2002
Messages
42
I am trying to update some old code I used years ago to work in a current process. The code below, for every source workbook in the same folder, will open, copy a specific range, paste that range in a summary/master workbook, and close the source document. It loops through this process for all excel documents in the folder, excluding the summary/master.

One change in how this is being used that may or may not be relevant... The source documents are all stored in a MS Teams folder...


VBA Code:
Private Sub cmdUpdate_Click()
Dim FS, i
Dim PlaceRow As Long
Dim OpenedName As String
Dim DoNotReopenActiveWB_Name As String
Dim DataBook As String

Sheet1.Range("A2:AF1000").ClearContents
Sheet1.Range("BA1:BA1000").ClearContents
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
DoNotReopenActiveWB_Name = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
DataBook = ActiveWorkbook.Name
PlaceRow = 1
Debug.Print DoNotReopenActiveWB_Name
Set FS = Application.FileSearch
With FS
    .LookIn = ActiveWorkbook.Path
    .Filename = "*.xlsx"
    If .Execute Then
        For i = 1 To .FoundFiles.Count
            If .FoundFiles(i) <> DoNotReopenActiveWB_Name Then
                PlaceRow = PlaceRow + 1
                Workbooks.Open .FoundFiles(i)
                OpenedName = ActiveWorkbook.Name
                Workbooks(DataBook).Sheets("Level 1") _
                    .Range("A" & PlaceRow & ":AI" & PlaceRow).Value = _
                Workbooks(OpenedName).Sheets("Level 1") _
                    .Range("A114:AI114").Value
                Workbooks(DataBook).Sheets("Table1") _
                    .Range("BA" & PlaceRow).Value = .FoundFiles(i)
                Workbooks(OpenedName).Close savechanges:=False
            End If
        Next i
    End If
End With
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,678
Office Version
2007
Platform
Windows
Try this

VBA Code:
Private Sub cmdUpdate_Click()
  Dim wFiles As Variant, sPath As String, i As Long
  Dim wb1 As Workbook, wb2 As Workbook
  
  Application.DisplayAlerts = False
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  
  Set wb1 = ThisWorkbook
  wb1.Sheets("Level 1").Range("A2:AI1000").ClearContents
  wb1.Sheets("Table1").Range("BA1:BA1000").ClearContents
  
  sPath = wb1.Path & "\"          '
  wFiles = Dir(sPath & "*.xlsx")  'all xlsx files
  i = 1                           'PlaceRow
  
  Do While wFiles <> ""
    If wFiles <> wb1.Name Then
      i = i + 1
      Set wb2 = Workbooks.Open(sPath & wFiles)
      wb1.Sheets("Level 1").Range("A" & i & ":AI" & i).Value = wb2.Sheets("Level 1").Range("A114:AI114").Value
      wb1.Sheets("Table1").Range("BA" & i).Value = wFiles
      wb2.Close savechanges:=False
    End If
    wFiles = Dir()
  Loop
  
  Application.EnableEvents = True
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,678
Office Version
2007
Platform
Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,098,860
Messages
5,465,115
Members
406,414
Latest member
Discorz

This Week's Hot Topics

Top