How to merge multiple worksheets into one worksheet horizontally or vertically via VBA

With the two macros described in this post, you will be able to combine multiple worksheets (of one workbook) into one (or master) worksheet. One macro is to copy data from different worksheets and paste them into one worksheet horizontally and the other one is to paste vertically.

First of all, below is the full program to merge different worksheets horizontally.

Sub Horizontal_Click() Application.DisplayAlerts = False 'Define variable Dim wbk As Workbook Dim ws As Worksheet 'Open workbook Set fnm = ThisWorkbook.Sheets(1).Cells(1, 2) Set wbk = Workbooks.Open(fnm) 'Set workbook as active workbook wbk.Activate 'Worksheets.count returns the number of worksheets For i = 1 To Worksheets.Count 'If there is a worksheet with name "Master" then delete this worksheet     If Worksheets(i).Name = "Master" Then         Worksheets(i).Delete     End If Next i 'Return number of all worksheet in the active workbook n = Worksheets.Count 'Add master worksheet after the last worksheet Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'Give the newly added worksheet a name ws.Name = "Master" a = 0 'loop through all worksheets For i = 1 To n 'Get the number of rows with data for each worksheet x = Worksheets(i).UsedRange.Rows.Count 'Return the number of columns with data for each worksheet y = Worksheets(i).UsedRange.Columns.Count 'loop through all cells in each worksheet For p = 1 To x  For q = 1 To y    b = a + q    'copy and paste    ws.Cells(p, b) = Worksheets(i).Cells(p, q)  Next q Next p a = a + y Next i 'Close workbook and save changes wbk.Save wbk.Close End Sub

And here is the code for how to merge vertically. This macro is more complex than the above one. But it is also not complicated. You can look into code in red or highlighted in yellow to figure out how it works.

Sub Vertical_Click() Application.DisplayAlerts = False 'Define variable Dim wbk As Workbook Dim ws As Worksheet 'Open workbook Set fnm = ThisWorkbook.Sheets(1).Cells(1, 2) Set wbk = Workbooks.Open(fnm) 'Set workbook as active workbook wbk.Activate 'Worksheets.count returns the number of worksheets For i = 1 To Worksheets.Count 'If there is a worksheet with name "Master" then delete this worksheet     If Worksheets(i).Name = "Master" Then         Worksheets(i).Delete     End If Next i 'Return number of all worksheet in the active workbook n = Worksheets.Count 'Add master worksheet after the last worksheet Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'Give the newly added worksheet a name ws.Name = "Master" a = 0 'loop through all worksheets For i = 1 To n 'Get the number of rows with data for each worksheet x = Worksheets(i).UsedRange.Rows.Count 'Return the number of columns with data for each worksheet y = Worksheets(i).UsedRange.Columns.Count 'Only the first row - column name - in the first worksheet will be kept, 'Otherwise, only data from the second row will be copied If i = 1 Then     For p = 1 To x      For q = 1 To y          b = a + p          ws.Cells(b, q) = Worksheets(i).Cells(p, q)      Next q     Next p ElseIf i > 1 Then     For p = 2 To x      For q = 1 To y          b = a + p          ws.Cells(b, q) = Worksheets(i).Cells(p, q)      Next q     Next p End If a = a + x - 1 Next i 'Close workbook and save changes wbk.Save wbk.Close End Sub

Only screenshot of combined worksheet in vertical way will be showed below. For the other case, you can run code and check by yourself.