Using the Dir Command To Cycle Through Files
The DIR command is used to cycle through file and directory tree structures. This example illustrates the use of the DIR command to open a set of Excel files within the same directory and copy data back to the main workbook. In addition, it copies data from seven worksheets within each workbook.
Program Code
Option Explicit
Public Sub LoopThroughWorksheets()
Dim strDirectoryPathToWorkbooks As String
Dim strExcelFileName As String
Dim wkbMasterWorkbook As Workbook
Dim wksMasterWorksheet As Worksheet
Dim wkbWorkbookToCopy As Workbook
Dim wksWorksheetToCopy As Worksheet
Dim i As Integer
Dim lngLastRowInMasterWorksheet As Long
Dim lngLastRowInWorksheetToCopy As Long
' **************************************************
' Put This Master Workbook In A Separate Directory
' Different Than The Other 49
' **************************************************
Application.ScreenUpdating = False
Set wkbMasterWorkbook = ThisWorkbook
' **************************************************
' Put The 49 Workbooks To Be Copied Here
' **************************************************
strDirectoryPathToWorkbooks = "C:\TestArea\"
strExcelFileName = Dir(strDirectoryPathToWorkbooks, vbNormal)
Do Until strExcelFileName = ""
' **************************************************
' Copy Each of the 49 Workbooks Into The Master
' **************************************************
Workbooks.Open (strDirectoryPathToWorkbooks & strExcelFileName)
Set wkbWorkbookToCopy = ActiveWorkbook
For i = 1 To 7
Set wksMasterWorksheet = wkbMasterWorkbook.Sheets(i)
Set wksWorksheetToCopy = wkbWorkbookToCopy.Sheets(i)
lngLastRowInMasterWorksheet = wksMasterWorksheet.Cells(Rows.Count, "A").End(xlUp).Row
lngLastRowInWorksheetToCopy = wksWorksheetToCopy.Cells(Rows.Count, "A").End(xlUp).Row
' ****************************************************************************
' This Copy Assumes One Heading Line Not To Be Copied and The Last Column is G
' ****************************************************************************
Range(wksWorksheetToCopy.Cells(2, "A"), wksWorksheetToCopy.Cells(lngLastRowInWorksheetToCopy, "G")).Copy wksMasterWorksheet.Cells(lngLastRowInMasterWorksheet + 1, "A")
Next i
wkbWorkbookToCopy.Close SaveChanges:=False
strExcelFileName = Dir
Loop
Application.ScreenUpdating = True
End Sub
