Announcement

Collapse
No announcement yet.

Combine multiple worksheets with dynamic range into one

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Combine multiple worksheets with dynamic range into one

    Hi,
    I am trying to combine the data in two sheets into one.
    Sheet 1 is called “RMT” which is a data dump that I get from the server. The number of rows in this is dynamic. Header will be in columns A1 to D1. Data is in the rows below the header.
    Sheet 2 is called “MSPS” which is also a data dump with dynamic rows. Header will be in columns A1 to D1. Data is in the rows below the header.
    I want to create a 3rd sheet called “Combined Data Sheet” which will have the data in Sheet 1 + Sheet 2.
    Sheet 2 data should be placed in the row right after where the Sheet 1 data ends. The header from Sheet 2 need not be copied.
    The copy should happen when I click the “Copy” button placed in Sheet 1.
    Could anyone help me create this in VBA please?

  • #2
    Re: Combine multiple worksheets with dynamic range into one

    Hi necrome,

    This is a very common request, which though there numerous threads for, try this:

    Code:
    Option Explicit
    
    Sub ConsData()
    
        'http://www.ozgrid.com/forum/showthread.php?t=167716
    
        Dim wrkMySheet As Worksheet, _
            wrkConsSheet As Worksheet
        Dim lngLastRow As Long, _
            lngOutputRow As Long, _
            lngMyCounter As Long
            
        Application.ScreenUpdating = False
        
        Set wrkConsSheet = Sheets("Combined Data Sheet") 'Sheet (tab) name to consolidate data. Change to suit.
        
        For Each wrkMySheet In ThisWorkbook.Sheets
            If wrkMySheet.Name = "RMT" Or wrkMySheet.Name = "MSPS" Then
                lngLastRow = wrkMySheet.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    If lngMyCounter = 0 Then
                        wrkMySheet.Range("A1:D" & lngLastRow).Copy Destination:=wrkConsSheet.Range("A1")
                    Else
                        lngOutputRow = wrkConsSheet.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        wrkMySheet.Range("A2:D" & lngLastRow).Copy Destination:=wrkConsSheet.Range("A" & lngOutputRow)
                    End If
                lngMyCounter = lngMyCounter + 1
            End If
        Next wrkMySheet
                
        Application.ScreenUpdating = True
    
    End Sub
    HTH

    Robert

    Comment


    • #3
      Re: Combine multiple worksheets with dynamic range into one

      Hi Robert,

      The code you provided worked...I bet you knew that already
      Thank you so much for taking the time to reply!

      Cheers!
      Zac.

      Comment


      • #4
        Re: Combine multiple worksheets with dynamic range into one

        Hey Zac,

        Thanks for the feedback and you're welcome. I'm glad OzGrid was able to provide you with a suitable solution

        Cheers,

        Robert

        Comment


        • #5
          Re: Combine multiple worksheets with dynamic range into one

          Hi Robert...

          What if I have more 2 worksheets to combine?
          I have 4.

          I have tried the above but it doesn't even compile 2 worksheets, the consolidated data only shows contents of 1 worksheet.

          Thanks heaps.
          Last edited by Trebor76; April 11th, 2013, 19:39. Reason: Removed requote of entire thread

          Comment


          • #6
            Re: Combine multiple worksheets with dynamic range into one

            In future please start your own Thread & also do not quote whole posts.


            here's some code to try

            Code:
            Option Explicit 
             
             '---------------------------------------------------------------------------------------
             ' Procedure : Combinedata
             ' Author    : Roy Cox
             ' Website   : www.excel-it.com
             ' Date      : 10/10/2010
             ' Amended   : 06/04/2013
             ' Purpose  : Combine data from all sheets to a master sheet
             '---------------------------------------------------------------------------------------
             '
            Sub Combinedata() 
                 
                Dim ws As Worksheet 
                Dim wsMain As Worksheet 
                Dim DataRng As Range 
                Dim Rw As Long 
                Dim Cnt As Integer 
                Const ShtName As String = "Summary" '<-destination sheet here
                Const sRw As Long = 10 'data starts in Row10
                 
                Cnt = 1 
                 
                Set wsMain = Worksheets(ShtName) 
                wsMain.Cells.Clear 
                 
                For Each ws In ThisWorkbook.Worksheets 
                    If ws.Name <> wsMain.Name Then 
                        Set DataRng = ws.Cells(sRw, 1).CurrentRegion 
                        If Cnt = 1 Then '<- first run
                            DataRng.Copy wsMain.Cells(sRw, 1) 
                            Cnt = Cnt + 1 '<- increase cnt to prevent copying headers subsequently
                        Else: Rw = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row + 1 
                             'don't copy header rows
                            With DataRng 
                                .Offset(1, 0).Resize(.Rows.Count - 1, _ 
                                .Columns.Count).Copy wsMain.Cells(Rw, 1) 
                            End With 
                        End If 
                    End If 
                Next ws 
                 
            End Sub
            Hope that Helps

            Roy

            New users should read the Forum Rules before posting

            For free Excel tools & articles visit my web site

            If I have helped you and you feel like putting your hand in your pocket please make a donation to Children in Need

            RoyUK's Web Site

            royUK's Database Form

            Where to paste code from the Forum

            About me.

            Comment

            Working...
            X