Skip to main content

Merging a particular Worksheet from Multiple Workbooks into one Worksheet (Skipping Heading Row, Hidden and Blank Rows)

Hello Everyone,

This time, I have come up with a code which will merge a particular sheet from Multiple Workbooks in a folder, into one Worksheet. While doing so, it will ignore Row 1st i.e. header row, Hidden and Blank Rows. So before using code, make sure following things:-
1. Change fPath variable in the code to an appropriate Folder Path holding all Input sheets.
2. Make a suitable heading row to match with those in the Input sheets.
3. Actually this code will paste copy data from Current Input sheet and paste it beneath the data imported from Former Input Sheet.
4. If you want more sheets to be imported then you can simply put those worksheets in the fPath folder after getting Former Imported Sheets out of the fPath folder. It will avoid Duplication as Code pastes data in the next of the last filled row and Former sheets will not be considered again. 



So Here is the code:-

       
    Dim shOutput As Worksheet                                               'Declaring Variables.
    Dim shInput As Worksheet
    Dim fPath As String
    Dim fName As String
    Dim uRng As Range
    Dim cRng As Range
    Dim fRng As Range
    Dim sRng As Range
    
Sub MergeIntoOneSheet()
    On Error GoTo ErrHandler                                                'Getting Error Handler on.
    
    Application.ScreenUpdating = False                                      'Switching Screen Updating off.
    Application.DisplayAlerts = False                                       'Switching Display Alerts off.
    
    Set shOutput = ThisWorkbook.ActiveSheet                                 'Marking Output Sheet.
    
    fPath = "S:\Metal\"                                                     'Change your Path here. The Path must end with "\"
    fPath = IIf(Right(fPath, 1) = "\", fPath, fPath & "\")                  'Ensuring "\" at the end
    
    fName = Dir(fPath & "*.xl*")                                            'Getting first input file name.
    
    Do
        LastRow = shOutput.UsedRange.Rows.Count + 1                         'Marking Last Row for Pasting Data.
        
        Set shInput = Workbooks.Open(fPath & fName).Sheets("Metal List")    'Opening the Input Sheet and Marking source Sheet.
                                                                            'Change your Source sheet Name here Say "Metal List"
        
        shInput.Rows(1).Delete xlUp                                         'Deleting Header Row Temporarily
        
        Set uRng = shInput.UsedRange.SpecialCells(xlCellTypeVisible)        'Marking Used Ranges while ignoring Heading Row & Hiddens.
        Set cRng = uRng.SpecialCells(xlCellTypeConstants)                   'Marking Constant Cells within Used Ranges.
        Set fRng = uRng.SpecialCells(xlCellTypeFormulas)                    'Marking Formula Cells with Used Ranges.
        If fRng Is Nothing Then Set fRng = cRng.Cells(1, 1)                 'Considering possiblities of No Formula cell.
        Set sRng = Intersect(uRng, Union(cRng.EntireRow, fRng.EntireRow))   'Making Sources Ranges to be copied by using
                                                                            'intersections of Constant, Formulas and Used Ranges.
        sRng.Copy
        shOutput.Cells(LastRow, 1).PasteSpecial xlPasteValues               'OR xlPasteALL - Pasting Data
        
        Application.CutCopyMode = False                                     'Clearing Clipboard.
        
        shInput.Parent.Close False                                          'Closing Input Sheet while not saving to cancel changes.
        
        fName = Dir                                                         'Getting Next Input File Name

        Set uRng = Nothing                                                  'Resetting Variables.
        Set cRng = Nothing
        Set fRng = Nothing
        Set sRng = Nothing
        
    Loop While fName <> ""
    
    shOutput.Columns.AutoFit                                                'Auto Fitting Columns    

    Application.ScreenUpdating = True                                       'Switching Screen Updating On.
    Application.DisplayAlerts = True                                        'Switching Display Alerts On.
        
    MsgBox "Finished", vbInformation

ErrHandler:                                                                 'Error Handler
    If Err.Number = 1004 Then
        Resume Next
    ElseIf Not Err.Number = 0 Then
        MsgBox Err.Description, vbExclamation
    End If
    
End Sub

Thats it with the explanation part.
If you have any problem in implementing the code then do comment with you workbooks.

You can see some application in the following link:-
http://www.excelforum.com/excel-programming-vba-macros/1069162-vba-to-combine-same-worksheet-in-different-workbooks-into-one-without-the-heading-2.html

Regards,
Vikas Gautam

Comments

Popular posts from this blog

Automation:- Sending Invitation to Meeting Using Excel VBA

Hello Everyone, In one of the previous post, I wrote about automating Sending Emails using Excel VBA. This time I have come up with a pretty similar code. The code below sends Outlook Meeting Invitations to recipients on one click. here is the Code:- Sub Send_Invite_Auto() Dim olApp As Outlook.Application Dim olApt As AppointmentItem Set olApp = New Outlook.Application 'Creating Outlook Session Set olApt = olApp.CreateItem(olAppointmentItem) 'Creating an Appointment With olApt .Subject = "Enter the subject here." 'Subject .Start = DateAdd("d", 5, Now) 'Enter Date + Time here. .Recipients.Add ("example@gmail.com") 'Recipient Name, Alias, or any other Attribute. .MeetingStatus = olMeeting 'olAppointmentItem with Meeting status olMeeting 'becom

Highlighting Duplicates across multiple sheets

Hi One and All, This time I have come up with some conditional formatting stuff. The aim is to highlight the duplicates across multiple sheets and with in the sheet as well. Assumptions:- 1. I am assuming that sheet names goes on like sheet1, sheet2, sheet3.... 2. The Target Column No. is same in all the sheets. I mean, as in the attached example, its Column A which is being targeted in both sheets.

Making Password Protected PDFs using Excel Vba and PDFtk Tool

Hi Everyone, This time, I have come up a VBA Code to generate Password protected PDFs using Excel. Actually, Excel Vba has .ExportAsFixedFormat Method to generate PDFs but this hasn't any Parameter which takes password to protect the PDFs. So I have used PDFtk Tool which provide Command Line Interface to make PDFs protected using Password. Actually, You can do various things using PDFtk Tool command line varying from creating, merging, Protecting and many other. So Download the PDFtk Tool from the following link:- Download PDFtk Tookit Here are the Steps:- 1. Install the PDFtk Toolkit. 2. Use the following code to Print or Export the Activesheet with a password.