Option Explicit
Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long, LastRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim DestRange As Range, FindRange As Range, i As Range, SourceRange As Range
Dim StartDate As Date, EndDate As Date, myVal As Date
Application.ScreenUpdating = False
'Enter a start date and an end date.
StartDate = Application.InputBox("Please enter a start date as MM/DD/YYYY.", "Macro Canceled")
If StartDate = False Then
MsgBox "Macro was cancelled.", 64, "Cancel was clicked."
Exit Sub
End If
EndDate = Application.InputBox("Please enter a end date as MM/DD/YYYY.", "Macro Canceled")
If EndDate = False Then
MsgBox "Macro was cancelled.", 64, "Cancel was clicked."
Exit Sub
End If
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' This is the folder path to point to the files you want to use.
FolderPath = "C:\Test\Test Files\"
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1
' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)
LastRow = WorkBk.Worksheets(1).Range("A24").End(xlDown).Row
' Set the source range to be A24 through I and LastRow.
Set SourceRange = WorkBk.Worksheets(1).Range("A24:I" & LastRow)
' Set the destination range to start at column A.
Set DestRange = SummarySheet.Range("A" & NRow)
' Copy the values from the source to the destination.
For Each i In SourceRange
myVal = CDate(i.Value)
If myVal >= StartDate <= EndDate Then
'Set the cell in column A to be the file name.
DestRange.Cells(NRow, 1).Value = WorkBk.Worksheets(1).Cells(2, 1).Value
DestRange.Cells(NRow, 2).Value = SourceRange.Cells(i.Row - 24 + 1, 1).Value
DestRange.Cells(NRow, 3).Value = SourceRange.Cells(i.Row - 24 + 1, 7).Value
DestRange.Cells(NRow, 4).Value = SourceRange.Cells(i.Row - 24 + 1, 9).Value
NRow = NRow + 1
End If
Next
'Place formatting here.
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = Dir()
LastRow = Empty
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
With SummarySheet
Range("A1").Select
Selection.EntireRow.Insert
Range("A1") = "Bond Name"
Range("B1") = "Date"
Range("C1") = "Int. Income"
Range("D1") = "Premium Amort."
End With
With SummarySheet
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A1:A10000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With SummarySheet.Sort
.SetRange Range("A1:D10000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
With SummarySheet
.Columns("C:D").Select
With Selection
.NumberFormat = "#,##0.00_);[red](#,##0.00)"
End With
End With
With SummarySheet
Rows("1:1").Select
With Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Columns.AutoFit
.Range("A1").Select
End With
End With
With SummarySheet
.Columns.AutoFit
.Range("A1").Select
End With
Application.ScreenUpdating = True
Windows("Summary Macro Date Range.xlsm").Activate
ActiveWindow.Close
End Sub
