VBA for importing data from multiple wordbooks to one sheet

masud8956

masud8956

Board Regular
Joined
Oct 22, 2016
Messages
163
Office Version
  1. 2016
  2. 2011
  3. 2007
Platform
  1. Windows
Hi,

I have some data within the range F78:U797 (16 columns and 720 rows) in multiple workbooks kept in one folder (C:\Desktop).

I need a VBA help to import those data from all those wordbooks in that folder automatically in a separate MASTER worksheet for further processing. One column has "date"inputs; so I would like to have the list in chronological order too.

Thanks in advance!
 
Last edited:
Sort by date Sort by votes
Hi again! @mumps

Not a biggie I hope.

Being the most patient guy in the world you have given me a fantastic code yesterday exactly how I wanted it. A little problem I did not see yesterday.

The code allows me to import data from all the files in "D:\Aircrew_Flying_Hour" folder and presently I have 19 files.

But after I have deleted some of the files from the folder and open my MASTER_CALCULATOR, somehow it seems to remember and compile data of all 19 files as before. How does that happen!

If it makes it more clear.....Now I have just 2 files in "D:\Aircrew_Flying_Hour" folder. So when I run the code I expect to see data import only from those 2 files to be pasted in "DATA" sheet. But it somehow imports data from rest 17 files which are not in the folder(!).

1. Is it happening due to "autorun of the macro" option?
2. Do you suggest using buttons instead of auto run?

All I need is removal of any previous data from "DATA" sheet and import of data as per the folder contents when I open the "MASTER_CALCULATOR".

After all these hectic steps in last few days I really feel embarrassed to ask anything more; I am a novice and at this point no one will understand this issue like you do.

TIA
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
See if this version solves the problem:
Code: 
Sub CopyRange()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim lastRow As Long
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "D:\Aircrew_Flying_Hour\"
    Application.DisplayAlerts = False
    Sheets("DATA").Delete
    Application.DisplayAlerts = True
    Worksheets.Add(before:=Sheets("Sheet1")).Name = "DATA"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Application.DisplayAlerts = False
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension, UpdateLinks:=False)
        If wkbSource.Name <> ThisWorkbook.Name Then
            With wkbSource
                '.Sheets("Summary of the Year").Unprotect Password:="2501"
                .Sheets("Summary of the Year").Range("F76:U76").Copy wkbDest.Sheets("DATA").Cells(1, 2)
                .Sheets("Summary of the Year").Range("G77:U796").Copy
                wkbDest.Sheets("DATA").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                .Close savechanges:=False
            End With
            strExtension = Dir
        End If
    Loop
    Application.DisplayAlerts = True
    lastRow = wkbDest.Worksheets("DATA").Cells(Rows.Count, "D").End(xlUp).Row
    wkbDest.Sheets("DATA").Range("B1:Q" & lastRow).AutoFilter Field:=3, Criteria1:="="
    wkbDest.Sheets("DATA").Range("B2:Q" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    If wkbDest.Sheets("DATA").AutoFilterMode Then wkbDest.Sheets("DATA").AutoFilterMode = False
    With wkbDest.Sheets("DATA").Range("B2")
        .Value = "1"
        .AutoFill Destination:=Range("B2").Resize(Range("D" & Rows.Count).End(xlUp).Row), Type:=xlFillSeries
    End With
    lastRow = wkbDest.Worksheets("DATA").Cells(Rows.Count, "D").End(xlUp).Row
    wkbDest.Worksheets("DATA").Sort.SortFields.Clear
    wkbDest.Worksheets("DATA").Sort.SortFields.Add Key:=Range("C2:C" & lastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wkbDest.Worksheets("DATA").Sort
        .SetRange Range("C1:C" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Well,

This time I got Run time error '9" Subscript out of range

After debugging line 12 is highlighted (Sheets("DATA").Delete)

Most importantly the "DATA" sheet disappeared from workbook!!
 
Upvote 0
The code rather than clearing the "DATA" sheet now actually deletes the sheet. This will remove any formulas to hopefully remove the problem of compiling data of all 19 files. A fresh DATA sheet is then re-created so that the data can be copied to it. I don't know why you are getting an error. Does the sheet "DATA" exist in the workbook? I tried the macro using the files you posted and it works properly for me without any errors.
 
Upvote 0
Yeah I checked again.

The sheet "DATA" exists (sheet1). I think the code is working till deleting the sheet. And then somehow the recreation is not taking place.

Is there a way instead of deleting the sheet the code clears the content prior to fresh data import?
 
Upvote 0
Try:
Code: 
Sub CopyRange()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim lastRow As Long
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "D:\Aircrew_Flying_Hour\"
    Sheets("DATA").Cells = ""
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Application.DisplayAlerts = False
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension, UpdateLinks:=False)
        If wkbSource.Name <> ThisWorkbook.Name Then
            With wkbSource
                '.Sheets("Summary of the Year").Unprotect Password:="2501"
                .Sheets("Summary of the Year").Range("F76:U76").Copy wkbDest.Sheets("DATA").Cells(1, 2)
                .Sheets("Summary of the Year").Range("G77:U796").Copy
                wkbDest.Sheets("DATA").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                .Close savechanges:=False
            End With
            strExtension = Dir
        End If
    Loop
    Application.DisplayAlerts = True
    lastRow = wkbDest.Worksheets("DATA").Cells(Rows.Count, "D").End(xlUp).Row
    wkbDest.Sheets("DATA").Range("B1:Q" & lastRow).AutoFilter Field:=3, Criteria1:="="
    wkbDest.Sheets("DATA").Range("B2:Q" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    If wkbDest.Sheets("DATA").AutoFilterMode Then wkbDest.Sheets("DATA").AutoFilterMode = False
    With wkbDest.Sheets("DATA").Range("B2")
        .Value = "1"
        .AutoFill Destination:=Range("B2").Resize(Range("D" & Rows.Count).End(xlUp).Row), Type:=xlFillSeries
    End With
    lastRow = wkbDest.Worksheets("DATA").Cells(Rows.Count, "D").End(xlUp).Row
    wkbDest.Worksheets("DATA").Sort.SortFields.Clear
    wkbDest.Worksheets("DATA").Sort.SortFields.Add Key:=Range("C2:C" & lastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With wkbDest.Worksheets("DATA").Sort
        .SetRange Range("C1:C" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Probably we are going to the right direction as:

1. DATA sheet is not deleted
2. The previous contents erased
3. I could see screen updating only for 2 files this time

After these actions pc hung for a long time. Through task manager I revived it again.

Got a few errors though. I am being as specific as possible so you can easily understand the problem.

This time 1st I got Run-time error '-2147417848 (80010108)' "saying "Method 'delete' of object 'range' failed"
After debugging line 29 was highlighted
wkbDest.Sheets("DATA").Range("B2:Q" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete

Followed by another Run-time Error '1004' for the same line saying "Unable to get the SpecialCells properly of the Range class"

Then I stopped the code by STOP button and ran it again immediately
I got Run-time error '91' saying "object variable or with block variable not set"
After debugging line 15 was highlighted
If wkbSource.name <> thisWorkbook.name Then
 
Last edited:
Upvote 0
It's difficult for me to determine why you are getting the errors because the macro works properly on the files you posted. Replace this line of code
Code: 
wkbDest.Sheets("DATA").Range("B2:Q" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
with this line:
Code: 
wkbDest.Sheets("DATA").Range("D2:D" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
Upvote 0
Tried and same result.

Just to make sure I am not messing it up here,,,,below are the 2 files available in the source folder now:

https://www.dropbox.com/s/5bn1d3mlhiynbtp/Aircrew Flying Hour-2003.xlsx?dl=0
https://www.dropbox.com/s/hnm7olas2a0d0ky/Aircrew Flying Hour-2004.xlsx?dl=0

The master file is below as I saved yesterday after getting the code #38 .

What I did was: opened the file below >> opened the VB window >>deleted existing code (module 1) >>pasted the latest one from #46 >> pressed run. I did not manually delete the data from DATA sheet before applying the code.

https://www.dropbox.com/s/ov270pnxg6h41z1/MASTER_CALCULATOR.xlsm?dl=0
 
Upvote 0
For some reason the links you provided don't work.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Q
  • Question Question
Import multiple photos from folders in columns
Replies
2
Views
157
Qba
Q
G
  • Question Question
remove columns from multiple Excel-files in a folder
Replies
5
Views
213
gjvv
G
C
  • Solved
Extracting data with VBA macro button from files in designated folder
2 3
Replies
20
Views
861
Micron
M
L
  • Question Question
replace data for multiple sheets from source file to destination file based on back up(date,time)
Replies
1
Views
167
leap out
L
O
  • Question Question
VBA code to merge data from files into one master file
Replies
3
Views
467
jkpieterse
jkpieterse

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

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