Need Help with My Existing Code to merge sheets

andyb16 · Jun 28th 2015

Hi All,

The attached sheet has my sample data - forum.ozgrid.com/index.php?attachment/65866/ .

I was able to build code to merge data in all sheets into a single sheet (all headers in all sheets are consistent). Data to be merged with headers starts on row7.

My aim is (and I am struggling here) is to run this code from a different workbook say "MergedSheets" which will

Prompt the user to select the target file from which sheets are to be merged.
Combine/merge all data sheets into one but this combined result should get added as a new worksheet in the "MergedSheets" worksheet with tab name as today's date.
Everyday/everytime this macro is run a new worksheet with today's date as name should get populated alongside yesterday's sheet.

My current code is as below:

Code

Sub ShtCombine()    Dim ws As Worksheet
    'Add Top Sheet or Pasting Combined Data
     Worksheets.Add().Name = "All_Sheets_Data"
     'Add Headings in first Row of top Sheet
     Sheets(2).Cells(7, 1).EntireRow.Copy
     Sheets(1).Cells(1, 1).PasteSpecial
          
    'Combine relevant rows to the mastersheet
    For Each ws In ActiveWorkbook.Worksheets
                If ws.Name <> ActiveSheet.Name Then
                    ws.UsedRange.Offset(7).Copy
                        With Range("A65536").End(xlUp).Offset(1, 0)
                            .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                            False, Transpose:=False
                            .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                            False, Transpose:=False
                            Application.CutCopyMode = False
                            Range("A1").Select
                        End With
                End If
            Next
End Sub

Display More

**KjBox** · Jun 28th 2015

Re: Need Help with My Existing Code to merge sheets

Try this in master "MergedSheets" workbook

Code

Sub ImportData()
    Dim wb As Workbook, lRow As Long, i As Integer, sPath As String
    
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        i = .Show: sPath = .SelectedItems(1)
    End With
    Set wb = Workbooks.Open(sPath)
    With wb
         '// Add temporary sheet for combined Data
        Sheets.Add
         '// Add headers and combine relevant rows to new sheet
        With .Sheets(1)
            .[a1:c1] = Array("Name", "ID", "Place")
            For i = 2 To Sheets.Count
                lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                Sheets(i).[a7].CurrentRegion.Offset(1).Copy .Cells(lRow, 1)
            Next
             '// Move the temporary sheet to this workbook
            ThisWorkbook.Activate
            .Move After:=ThisWorkbook.Sheets(Sheets.Count)
            wb.Close False '// Close the selected file without saving the temporary sheet
        End With
    End With
     '// Name the new sheet with date and time of creation
    Sheets(Sheets.Count).Name = Format(Now, "mm-dd-yyyy_hh.nn")
    Application.ScreenUpdating = True
    
End Sub

Display More

andyb16 · Jun 28th 2015

Re: Need Help with My Existing Code to merge sheets

Thanks KjBox!!

This worked and I was able to figure out much of the code

Just one request...in the sample workbook there were 3 columns...in reality there maybe several with varying column numbers everyday (though number of columns and headers will always be consistent and in same order). Is there anyway to account for that?

Thanks.

**KjBox** · Jun 28th 2015

Re: Need Help with My Existing Code to merge sheets

Try this

Code

Sub ImportData()
    Dim Hdrs, wb As Workbook, lRow As Long, i As Integer, sPath As String
    Hdrs = Array("Name", "ID", "Place", "Header4", "Header5", "Header6", _
                    "Header7", "Header8", "Header9", "Header10")
    
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        i = .Show: If i = 0 Then Exit Sub
        sPath = .SelectedItems(1)
    End With
    Set wb = Workbooks.Open(sPath)
    With wb
         '// Add temporary sheet for combined Data
        Sheets.Add
         '// Add headers and combine relevant rows to new sheet
        With .Sheets(1)
            .[a1].Resize(, UBound(Hdrs) + 1) = Hdrs
            For i = 2 To Sheets.Count
                lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                Sheets(i).[a7].CurrentRegion.Offset(1).Copy .Cells(lRow, 1)
            Next
             '// Move the temporary sheet to this workbook
            ThisWorkbook.Activate
            .Move After:=ThisWorkbook.Sheets(Sheets.Count)
            wb.Close False '// Clse the selected file without saving changes
        End With
    End With
     '// Name the new sheet with date and time of creation
    Sheets(Sheets.Count).Name = Format(Now, "mm-dd-yyyy_hh.nn")
    Application.ScreenUpdating = True
    
End Sub

Display More

Change

Code

Hdrs = Array("Name", "ID", "Place", "Header4", "Header5", "Header6", _
                "Header7", "Header8", "Header9", "Header10")

To the names of your actual headers.

andyb16 · Jun 28th 2015

Re: Need Help with My Existing Code to merge sheets

Thanks You!!

This was really helpful.

**KjBox** · Jun 28th 2015

Re: Need Help with My Existing Code to merge sheets

This is better, gets headers directly from sheet, no need to change anything.

Code

Sub ImportData()
    Dim wb As Workbook, lRow As Long, i As Integer, sPath As String
    
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        i = .Show: If i = 0 Then Exit Sub
        sPath = .SelectedItems(1)
    End With
    Set wb = Workbooks.Open(sPath)
    With wb
         '// Add temporary sheet for combined Data
        Sheets.Add .Sheets(1)
         '// Add headers and combine relevant rows to new sheet
        With .Sheets(1)
            For i = 2 To Sheets.Count
                Sheets(i).Rows(7).Copy .Rows(1)
                lRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                Sheets(i).[a7].CurrentRegion.Offset(1).Copy .Cells(lRow, 1)
            Next
             '// Move the temporary sheet to this workbook
            ThisWorkbook.Activate
            .Move After:=ThisWorkbook.Sheets(Sheets.Count)
            wb.Close False '// Close the selected file without saving temporary sheet
        End With
    End With
     '// Name the new sheet with date and time of creation
    Sheets(Sheets.Count).Name = Format(Now, "mm-dd-yyyy_hh.nn")
    Application.ScreenUpdating = True
    
End Sub

Display More

andyb16 · Jun 28th 2015

Re: Need Help with My Existing Code to merge sheets

Thanks!!

:thumbcoo:

**KjBox** · Jun 28th 2015

Re: Need Help with My Existing Code to merge sheets

You're welcome

Need Help with My Existing Code to merge sheets

Participate now!

Share