extract data from multiple data (specific tab) in one folder and consolidate these date into one master sheet

scolame

New Member
Joined
Oct 17, 2018
Messages
3
Hi all,

This is a fairly common question, and is regarding creating a VBA code to pull multiple dataset from different excel files and consolidate them into one master spreadsheet. All files have the same format, same columns but different number of rows. However, with my situation, in each excel file there are 4 difference tabs, specifically I only want to extract data from the tab called "data", rest are not needed.

It would even more useful if I could also only extract data from specific files in the folder.I.e. I have a specific list of file that I want to extract and consolidate into one sheet. For your information, t
he file name would be "PN_8032 Line Item Report as at 20181017", and first 7 characters would change based on the listing files I want to include.


Any advice or available code set would be greatly appreciated.

Thanks

scolame
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
So I have this code, but the issue is that it only copies up the 16th row for all data set? Would any of you be able to see why this is the case?

Code:
Option Explicit
Sub Consolidate()
'Summary:    Merge files in a specific folder into one master sheet (stacked)
'            Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wsMaster As Worksheet
'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False   'turn off system messages for now
    
    Set wsMaster = ThisWorkbook.Sheets("Master")    'sheet report is built into (change sheet name)
With wsMaster
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        .UsedRange.Offset(1).EntireRow.Clear
        NR = 2
    Else
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If
'Path and filename (edit this section to suit)
    MsgBox "Please select a folder with files to consolidate"
    Do
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = "C:\2010\Test\"
            .AllowMultiSelect = False
            .Show
            If .SelectedItems.Count > 0 Then
                fPath = .SelectedItems(1) & "\"
                Exit Do
            Else
                If MsgBox("No folder chose, do you wish to abort?", _
                    vbYesNo) = vbYes Then Exit Sub
            End If
        End With
    Loop
    
    fPathDone = fPath & "C:\Users\EIL886\Desktop\forecast build up\consolidate VBA\Imported\"     'remember final \ in this string (change to your desired folder)
    On Error Resume Next
        MkDir fPathDone                 'creates the completed folder if missing
    On Error GoTo 0
    fName = Dir(fPath & "*.xls*")       'listing of desired files, edit filter as desired
'Import a sheet from found files
    Do While Len(fName) > 0
        If fName <> ThisWorkbook.Name Then              'don't reopen this file accidentally
            Set wbData = Workbooks.Open(fPath & fName)  'Open file
         
        'This is the section to customize, replace with your own action code as needed
            Dim ws As Worksheet
    For Each ws In wbData.Sheets(Array("Data"))
            LR = Range("A" & Rows.Count).End(xlUp).Row  'Find last row
            ws.Range("A2:A" & LR).EntireRow.Copy .Range("A" & NR)
            wbData.Close False                                'close file
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1  'Next row
                Next ws
                    End If
        fName = Dir                                       'ready next filename
        
  
        
    Loop
End With
ErrorExit:    'Cleanup
    ActiveSheet.Columns.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
End Sub
 
Upvote 0
looks like the code looking for the last row in the first tab "summary", being the 16th row, and copying 16 rows of data in the "data" tab. Would you know why this is the case?

Any advice would be greatly appreciated!!

Thanks
 
Upvote 0
For your LR variable, it doesn't look like your updating the sheet being evaluated.
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,161
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top