Consolidate_Workbooks

Sub Consolidate_Workbooks()

Set wb = ThisWorkbook

Set ws = wb.Worksheets("Data")

ws.Range("A3:M" & Rows.Count).ClearContents

Location = wb.Path & "\"

Filename = Dir(Location & "*.xlsx")

d = 3

Do While Filename <> ""

Workbooks.Open (Location & Filename)

lrow = Range("A3").CurrentRegion.Rows.Count

For r = 3 To lrow

ws.Range("A" & d & ":M" & d).Value = Range("A" & r & ":M" & r).Value

d = d + 1

Next r

Workbooks(Filename).Close

Filename = Dir

Loop

End Sub