Solved

Automate the merge of 2 sheets

Posted on 2014-04-01
8
89 Views
Last Modified: 2014-04-02
Simple enough question.

See attached.

I have 3 sheets containing animal names (!) in column "A".

How do I automate this so that my fourth sheet contains ALL the animals in the previous 3 sheets.
First animal in cell A1, second in A2 etc

Thanks!
AUtomateMerge.xlsm
0
Comment
Question by:Patrick O'Dea
  • 4
  • 3
8 Comments
 
LVL 32

Expert Comment

by:Rob Henson
ID: 39969870
Assuming that your scenario is actually bigger than this, have you tried the "Multiple Consolidated Range" option of Pivot table?

Thanks
Rob H
0
 
LVL 39

Expert Comment

by:nutsch
ID: 39969875
Run the attached ConsolidateSheets macro after selecting the sheets you want to consolidate and it should to just fine.

Sub ConsolidateSheets()
Dim sht As Worksheet, shtDone As Worksheet


Set shtDone = shtConsolidateSheets(bolTitles:=False, _
                                        strSummary:="All", _
                                        bolTab:=False, _
                                        strTabTitle:="Month", _
                                        sFirstCell:="A1", _
                                        bSelectedOnly:=True)
End Sub


Function shtConsolidateSheets(Optional sRangeToInclude As String = "", _
                            Optional bolTitles As Boolean = True, _
                            Optional strSummary As String = "All", _
                            Optional bolTab As Boolean = False, _
                            Optional strTabTitle As String = "BU", _
                            Optional sFirstCell As String = "A1", _
                            Optional bSelectedOnly As Boolean = False, _
                            Optional sAdditionalCells As String = "", _
                            Optional lLastCol As Long = 0, _
                            Optional lLastColOffset As Long = 0) As Worksheet

Dim shtDone As Worksheet, lLastRow As Long, rgLoop As range, rgCellsToInclude As range
Dim shtLoop As Worksheet, firstSheet As Boolean, lColOffset As Long, lColLoop As Long
Dim lgTabCol As Long, lIncrement As Long, sSelectedSheets As String
Dim arrSheets As Variant, lLoop As Long, rgAddtlCells As range

'Const bolTitles As Boolean = True 'True if sheets have titles, false if they don't
'Const strSummary As String = "All" ' update to the name of the consolidated destination
'Const bolTab As Boolean = True 'get data from tab name ? True / False
'Const strTabTitle As String = "BU" 'title of column from tab name if bolTab=true
'Const sFirstCell As String = "B6" 'define first cell of data to copy (based on current region)

'turn off updates to speed up code execution
With application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

For Each shtLoop In IIf(bSelectedOnly, ActiveWindow.SelectedSheets, ActiveWorkbook.Worksheets)
    sSelectedSheets = sSelectedSheets & "\" & shtLoop.Name
Next

sSelectedSheets = Mid(sSelectedSheets, 2)
arrSheets = Split(sSelectedSheets, "\")

Set shtDone = Sheets.Add(Count:=1)

On Error Resume Next
shtDone.Name = strSummary

If Err.Number <> 0 Then
    ActiveWorkbook.Sheets(strSummary).Delete
    shtDone.Name = strSummary
    Err.Clear
End If

firstSheet = True
lLastRow = 1

If Len(sAdditionalCells) > 0 Then
    Set rgAddtlCells = range(sAdditionalCells)
    If Err <> 0 Then
        Set rgAddtlCells = Nothing
        Err.Clear
    End If
End If

For lLoop = LBound(arrSheets) To UBound(arrSheets)

    Set shtLoop = Sheets(arrSheets(lLoop))
    
    'determine what range to send
    If Len(sRangeToInclude) > 0 Then
        Set rgCellsToInclude = shtLoop.range(sRangeToInclude)
        If Err <> 0 Then
            Set rgCellsToInclude = shtLoop.range(sFirstCell).CurrentRegion
            Err.Clear
        End If
    Else
        If lLastCol > 0 Then
            Set rgCellsToInclude = shtLoop.range(sFirstCell, _
                    shtLoop.Cells(Rows.Count, lLastCol).End(xlUp).Offset(, lLastColOffset))
        Else
            Set rgCellsToInclude = shtLoop.range(sFirstCell).CurrentRegion
        End If
    End If
        
    If shtLoop.Name = strSummary Then GoTo nxtSht

    If bolTitles = True And firstSheet = False Then
        
        With rgCellsToInclude
            .Offset(1).Resize(.Rows.Count - 1).Copy
            lIncrement = .Rows.Count - 1
        End With
        
        With shtDone.Cells(lLastRow + 1, 1 + lColOffset)
            .PasteSpecial Paste:=xlValues
            .PasteSpecial Paste:=xlFormats
        End With

    Else
        
        With rgCellsToInclude
            .Copy
            lIncrement = .Rows.Count
        End With
        
        With shtDone.Cells(lLastRow + IIf(bolTitles, 1, 0), 1 + lColOffset)
            .PasteSpecial Paste:=xlValues
            .PasteSpecial Paste:=xlFormats
        End With
        
        If bolTab = True And firstSheet = True Then
            shtDone.Cells(2, lColOffset + 1) = strTabTitle
            shtDone.Cells(lLastRow, lColLoop).Resize(lIncrement) = shtLoop.Name
        End If
        
    End If
    
    If bolTab = True Then
        shtDone.Cells(lLastRow, rgCellsToInclude.Columns.Count + 1).Resize(rgCellsToInclude.Rows.Count) = shtLoop.Name
    End If
    
    If Not rgAddtlCells Is Nothing Then
        lColLoop = rgCellsToInclude.Columns.Count + IIf(bolTab, 2, 1)
        For Each rgLoop In shtLoop.range(sAdditionalCells).Cells
            shtDone.Cells(lLastRow + 1, lColLoop).Resize(lIncrement) = rgLoop.Value
            lColLoop = lColLoop + 1
        Next rgLoop
    End If
        
    firstSheet = False
    
    lLastRow = lLastRow + lIncrement

nxtSht:
Next lLoop

With application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With


Set shtConsolidateSheets = shtDone
End Function

Open in new window

0
 

Author Comment

by:Patrick O'Dea
ID: 39973298
nutsch,

How do I select the sheets to be merged?
Lets say there were 3 sheets , Sheet1, Sheet2, Sheet3.
0
Best Practices: Disaster Recovery Testing

Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.

 

Author Comment

by:Patrick O'Dea
ID: 39973309
Actually my last question is open to ALL!

(Just in case nutsch is not here today!)

How do I select the sheets to be merged?
Lets say there were 3 sheets , Sheet1, Sheet2, Sheet3.
0
 
LVL 39

Expert Comment

by:nutsch
ID: 39973314
Select the first sheet, hold SHIFT and select the last sheet in the group.

If they're not next to each other, select the first sheet, then hold CTRL as you select the other sheets.

Thomas
0
 

Author Comment

by:Patrick O'Dea
ID: 39973367
Thanks Thomas,

That works a treat!

A couple of questions before I close off the question.

1. Is it possible to supress the headers (which are repeated for every sheet).  I guess I dont want the first row of each sheet - except perhaps the first

2. How familiar are you with this utility? How much do you trust it?

Thanks again.
0
 
LVL 39

Accepted Solution

by:
nutsch earned 500 total points
ID: 39973744
1. If you have headers, change the bolTitles parameters to True, as in

Set shtDone = shtConsolidateSheets(bolTitles:=True, _
                                        strSummary:="All", _
                                        bolTab:=False, _
                                        strTabTitle:="Month", _
                                        sFirstCell:="A1", _
                                        bSelectedOnly:=True)

Your sample data didn't have a title so I coded accordingly.

2. I wrote it, and I trust it fully for its limited purpose. Watch out for empty rows and columns. The macro works off of the Currentregion to find out what to copy, so if you have a fully empty column or row in the middle of your data, it will not extend past the gap.

Thomas
0
 

Author Closing Comment

by:Patrick O'Dea
ID: 39974208
Superb!

Worth a lot more than the 500 points!
0

Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

773 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question