Question : Combine multiple Excel sheets into one sheet

Hello, I'm trying to merge data from multiple spreadsheets into one.

Each sheet has a large block of values where the rows are the categories and the columns are the years. There are also two other cells on each sheet to identify the Company and Ticker. The row & column positions are the same on each sheet.

The target sheet has a simpler structure -- Company, Ticker, Category, Year, and the Value.

How can I get a script to go through each sheet and populate the target sheet?

I've attached a sample workbook.

Thanks!
 

Answer : Combine multiple Excel sheets into one sheet

Keep only those worksheets which you want to merge.
This macro will generate 'MERGED SHEET' as an output.

Sub GenerateData()
    Dim SrcShObj As Worksheet
    Dim DestShObj As Worksheet
    Dim CompanyCell As Range
    Dim TickerCell As Range
    Dim CellContStartRow As Long
    Dim CellContEndRow As Long
    Dim CellContStartCol As Long
    Dim CellContEndCol As Long
   
    Dim DestCompanyCol As Long
    Dim DestTickerCol As Long
    Dim DestCategCol As Long
    Dim DestYearCol As Long
    Dim DestCellCont As Long
    Dim DestCurrentRow As Long
   
    Dim ColIndex As Long
   
    Set DestShObj = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    DestShObj.Name = "MERGED SHEET"
   
    DestCompanyCol = 1
    DestTickerCol = 2
    DestCategCol = 3
    DestYearCol = 4
    DestCellCont = 5
    DestCurrentRow = 2
   
    For Each SrcShObj In ThisWorkbook.Worksheets
        If SrcShObj.Name <> "MERGED SHEET" Then
            CellContStartRow = 12
            CellContEndRow = SrcShObj.Cells.SpecialCells(xlCellTypeLastCell).Row
            CellContStartCol = 6
            CellContEndCol = SrcShObj.Cells.SpecialCells(xlCellTypeLastCell).Column
           
            Set CompanyCell = SrcShObj.Cells(6, 4)
            Set TickerCell = SrcShObj.Cells(7, 8)
           
            For ColIndex = CellContStartCol To CellContEndCol
                'Company
                DestShObj.Activate
                DestShObj.Cells(DestCurrentRow, DestCompanyCol) = CompanyCell.Text
                Call DestShObj.Cells(DestCurrentRow, DestCompanyCol).AutoFill(DestShObj.Range(DestShObj.Cells(DestCurrentRow, DestCompanyCol), DestShObj.Cells(DestCurrentRow + CellContEndRow - CellContStartRow - 1, DestCompanyCol)))
               
                'Ticker
                DestShObj.Cells(DestCurrentRow, DestTickerCol) = TickerCell.Text
                Call DestShObj.Cells(DestCurrentRow, DestTickerCol).AutoFill(DestShObj.Range(DestShObj.Cells(DestCurrentRow, DestTickerCol), DestShObj.Cells(DestCurrentRow + CellContEndRow - CellContStartRow - 1, DestTickerCol)))
               
                'Category
                SrcShObj.Activate
                SrcShObj.Range(SrcShObj.Cells(CellContStartRow, CellContStartCol - 1), SrcShObj.Cells(CellContEndRow, CellContStartCol - 1)).Copy
               
                DestShObj.Activate
                DestShObj.Cells(DestCurrentRow, DestCategCol).Select
                ActiveSheet.Paste
               
                'Year
                SrcShObj.Activate
                SrcShObj.Cells(CellContStartRow - 1, ColIndex).Copy
               
                DestShObj.Activate
                DestShObj.Cells(DestCurrentRow, DestYearCol).Select
                ActiveSheet.Paste
                Call DestShObj.Cells(DestCurrentRow, DestYearCol).AutoFill(DestShObj.Range(DestShObj.Cells(DestCurrentRow, DestYearCol), DestShObj.Cells(DestCurrentRow + CellContEndRow - CellContStartRow - 1, DestYearCol)), xlFillCopy)
               
                'Cell Content
                SrcShObj.Activate
                SrcShObj.Range(SrcShObj.Cells(CellContStartRow, ColIndex), SrcShObj.Cells(CellContEndRow, ColIndex)).Copy
               
                DestShObj.Activate
                DestShObj.Cells(DestCurrentRow, DestCellCont).Select
                ActiveSheet.Paste
               
                DestCurrentRow = DestShObj.Cells.SpecialCells(xlCellTypeLastCell).Row
            Next
        End If
    Next
   
    DestShObj.Cells(1, DestCompanyCol) = "Company"
    DestShObj.Cells(1, DestTickerCol) = "Ticker"
    DestShObj.Cells(1, DestCategCol) = "Category"
    DestShObj.Cells(1, DestYearCol) = "Year"
    DestShObj.Cells(1, DestCellCont) = "Cell Content"

    MsgBox "Process completed"
End Sub