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