Tuesday, March 8, 2016

Combine multiple Excel Worksheets Into One

In this post I share about a project where I needed to combine multiple Excel worksheets into one using Visual Basic coding. The code combined 66 worksheets into 1 containing the entire King James Version of the Bible.


I have started to work on a book project which requires several texts from the King James Version of the Bible to be included. Rather than type each text into the book, I wondered if there might be a better way.

KJV Bible in Excel Format

I searched online for "King James Version Excel," and found the following link to be helpful:

The Spreadsheet Page > King James Bible

However, when I viewed the Excel workbook after downloading, I realized that each book of the Bible (a total of 66) was included its own individual spreadsheet. In ordinary circumstances multiple spreadsheets would not be a problem, but 66 spreadsheets - far too many.

Combining Multiple Worksheets

Thus, I returned to the Internet to search for some technique to combine multiple Excel worksheets into one. The best option I found is the one listed below. The Visual Basic code combines all of the worksheets into a new worksheet entitled "Master."

VBA Express > Combine All Worksheets Into One

The code as written works well for the Microsoft Windows version of Excel. However, it only merged the first column of data on the Mac version of Excel. The Visual Basic code automatically calculates the number of columns to import. When I manually entered the number of columns (2 in my case), the code worked perfectly.

All of the worksheets should have the same structure with neatly arranged data and the same number of columns. A large number of worksheets takes a few seconds to process, but the end result saved a lot of time.

You can find my combined file at the link below.

King James Version Bible



The Code (for Mac)

The modified code is below. To use (Mac instructions)

1. Copy the code below. Note the highlighted code below to specify the number of columns.
2. Open the workbook that contains worksheets you want to combine.
3. Click on the Developer tab and choose Visual Basic. Activate the Developer tab by selecting Preferences > View and place a check by "In Ribbon, show Developer tab."
4. Expand the folders until it appears like this:
 5. Paste in the copied code.
 6. Run the code using the Play button.
7. You should see the progress displayed in the status bar.

Sub CopyFromWorksheets() 
    Dim wrk As Workbook 'Workbook object - Always good to work with object variables
    Dim sht As Worksheet 'Object for handling worksheets in loop
    Dim trg As Worksheet 'Master Worksheet
    Dim rng As Range 'Range object
    Dim colCount As Integer 'Column count in tables in the worksheets
     
    Set wrk = ActiveWorkbook 'Working in active workbook
     
    For Each sht In wrk.Worksheets 
        If sht.Name = "Master" Then 
            MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ 
            "Please remove or rename this worksheet since 'Master' would be" & _ 
            "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" 
            Exit Sub 
        End If 
    Next sht 
     
     'We don't want screen updating
    Application.ScreenUpdating = False 
     
     'Add new worksheet as the last worksheet
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 
     'Rename the new worksheet
    trg.Name = "Master" 
     'Get column headers from the first worksheet
     'Column count first
    Set sht = wrk.Worksheets(1) 
    colCount = 2 
     'Now retrieve headers, no copy&paste needed
    With trg.Cells(1, 1).Resize(1, colCount) 
        .Value = sht.Cells(1, 1).Resize(1, colCount).Value 
         'Set font as bold
        .Font.Bold = True 
    End With 
     
     'We can start loop
    For Each sht In wrk.Worksheets 
         'If worksheet in loop is the last one, stop execution (it is Master worksheet)
        If sht.Index = wrk.Worksheets.Count Then 
            Exit For 
        End If 
         'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
        Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 
         'Put data into the Master worksheet
        trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 
    Next sht 
     'Fit the columns in Master worksheet
    trg.Columns.AutoFit 
     
     'Screen updating should be activated
    Application.ScreenUpdating = True 
End Sub 

No comments:

Post a Comment