Sub minger15()
'Assumes the 3 source workbooks are all open before this macro is run
Dim Bks As Variant, newWB As Workbook, sht As Worksheet, i As Long, ct As Long
Const S1 As String = "SalesLineSummary" 'change name to suit
Const S2 As String = "SheetsConsolidated" 'change name to suit
Bks = Array("Core.xlsx", "Trading.xlsx", "Base.xlsx")
'1.create a sheet that pulls the Sales line (Range B20:M20) on each of the segment sheets into one new book
Set newWB = Workbooks.Add(xlWBATWorksheet)
With newWB
.Sheets("Sheet1").Range ("A1:B1"), Value = Array("Segment", "Sales")
For i = LBound(Bks) To UBound(Bks)
For Each sht In Workbooks(Bks(i)).Worksheets
If sht.Name <> "Summary" Then
ct = ct + 1
.Sheets("Sheet1").Range("A1").Offset(ct, 0).Value = sht.Name
.Sheets("Sheet1").Range("B1:M1").Offset(ct, 0).Value = sht.Range("B20:M20").Value
End If
Next sht
Next i
.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & _
S1 & ".xlsx", FileFormat:=51 'change file extension & format to suit
End With
'2. I would like to create a workbook that creates a sheet for each segment
' (Sheet name would = the Segment Name) from each of those individual workbooks
Set newWB = Workbooks.Add(xlWBATWorksheet)
With newWB
For i = LBound(Bks) To UBound(Bks)
For Each sht In Workbooks(Bks(i)).Worksheets
If sht.Name <> "Summary" Then
sht.Copy after:=.Sheets(.Sheets.Count)
End If
Next sht
Next i
Application.DisplayAlerts = False
.Sheets(1).Delete
Application.DisplayAlerts = True
.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & _
S2 & ".xlsx", FileFormat:=51 'change file extension & format to suit
End With
End Sub