See how far this gets you.
Sub Get_Info()
Dim sPath As String
Dim sFil As String
Dim owb As Workbook
Dim twb As Workbook
Dim j As Long
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
j = 2
Set twb = ThisWorkbook
sPath = ThisWorkbook.Path & "\"
sFil = Dir(sPath & "*.xl*")
Do While sFil <> "" And sFil <> twb.Name
Set owb = Workbooks.Open(sPath & sFil)
With twb.Sheets("Sheet1").Cells(j, 3) '<----- Change as required
.Offset(, -1).Value = "Row 16"
.Offset(1, -1).Value = "Row 79"
.Offset(, -2).Value = Left(owb.Name, InStr(owb.Name, ".xls") - 1)
.Resize(, 12).Value = owb.Sheets("Sheet1").Cells(16, 2).Resize(, 12).Value '<----- Change as required
.Offset(1).Resize(, 12).Value = owb.Sheets("Sheet1").Cells(79, 2).Resize(, 12).Value '<----- Change as required
End With
owb.Close False
j = j + 4
sFil = Dir
Loop
With Application
.Calculation = xlAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Bookmarks