Merge Specific Sheets into an exsisting sheet using VBA

whitts15

New Member
Joined
Sep 9, 2014
Messages
1
Hi all,

Complete VBA novice here and i have been trying this for a few days and have finally succumbed to all the greatness on here.

I have a workbook = Sales Sheet 1
Within the workbook are Multiple Sheets

I want a VBA code that will merge three specific sheets into an existing sheet.

I am using Excel 2013 and have the following code so far which i got from a link that was posted on here previously Merge cells from all or some worksheets into one Master sheet

The code i am using is picking all the sheets, however i only want it to copy from the following sheets: "Mike" "Conor" "Kris".

It is also picking up the headers on the sheets which i dont want.

And finally is placing it into a new sheet called "NewSummary", i want the data to be pasted into an already existing sheet called "Summary", where i have the headers so it must be placed starting from Row 2.

Can anyone please help? Please go easy on me.

Thanks in advance.

The code i am using - and yes i realize its probably completely wrong and has hints all the way through it is here:

Rich (BB code):
Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
    On Error Resume Next
    LastCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function


Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    ' Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True


    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "NewSummary"
    
        ' Fill in the start row.
    StartRow = 2


    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then


            ' Find the last row with data on the summary worksheet.
            Last = LastRow(DestSh)


            ' Specify the range to place the data.
            Set CopyRng = sh.UsedRange


            ' Test to see whether there are enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the " & _
                   "summary worksheet to place the data."
                GoTo ExitTheSub
            End If


            ' This statement copies values and formats from each
            ' worksheet.
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


          


        End If
    Next


ExitTheSub:


    Application.Goto DestSh.Cells(1)


    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 

Some videos you may like

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

Watch MrExcel Video

Forum statistics

Threads
1,109,447
Messages
5,528,803
Members
409,837
Latest member
karnasrinivas
Top