VBA for importing data from multiple wordbooks to one sheet

[masud8956]

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!

 

[mumps]

Even though the sheets are protected, the macro should still work. Perhaps you could upload a copy of 2 or 3 of your source files to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. If the workbooks contains confidential information, you could replace it with generic data.

 

[Fluff]

Cross posted https://www.excelforum.com/excel-pr...wordbooks-to-one-sheet-of-a-new-wordbook.html

Cross-Posting
While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

 

[6StringJazzer]

Crossposted to ExcelForum

ETA: whoops missed notice from Moderator, didn't see second page

 

[masud8956]

Sorry!

I am new in the forum. Did not go through forum rules earlier. Won't happen again.

 

[masud8956]

Cross post link below:

https://www.excelforum.com/excel-pr...wordbooks-to-one-sheet-of-a-new-wordbook.html

 

[masud8956]

Hi,

I am still living with this problem for quite a few months now. Refreshing the details below:

I have some data within the range F76:U798 (16 columns and 721 rows including headers) in the same sheet of multiple workbooks (identical in configuration) kept in one folder.

I need a VBA help to import those data from all those wordbooks in that folder automatically (when file opened) in a separate worksheet named "MASTER_CALCULATOR" for further processing.

1. The folder name is Aircrew_Flying_Hour. Location> D:\Aircrew_Flying_Hour\.

2. Source file extensions are xlsx.

3. Sheet names with the input range are identical. Each source file is a consolidation of one individual year. All source files are identical. The source sheet name is Summary of the Year ("Sheet 16" of each source file).

4. The 16 columns have headers in row 76 starting column F going upto column U.

5. Destination wordbook has only one sheet named DATA ("Sheet 1") which will contain the same headers in row 1 starting at column B. The destination file (named MASTER_CALCULATOR) is also located in the same folder with source files.

6. Summary of the Year sheets (source files) are locked with password.

I tried the code below which seem to be close but coming with an error (Run time error 9 for the line highlighted in Blue):

[COLOR=#333333]Sub LoopThroughDirectory()

Dim MyFile As String
Dim erow
Filepath = "D:\Aircrew_Flying_Hour"
MyFile = Dir(Filepath)


Do While Len(MyFile) > 0
If MyFile = "Master_Calculator.xlsm" Then
Exit Sub
End If


Workbooks.Open (Filepath & MyFile)


Range("F76 : U796").Copy
ActiveWorkbook.Close


erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
[COLOR=#0000ff]ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 16))[/COLOR]


MyFile = Dir


Loop
End Sub[/COLOR]

How can I make it work?

 

[masud8956]

Hi mumps,

Tried the Macro you provided at #4 . It returns the columns and rows alright along with the source formatting but data outside the range is somehow imported. Though I have many blank cells within the range but most of the data field is returned with zero where there should be data. It is also associated with the warning:"This wordbook contains one or more links that cannot be updated".

I have been struggling with this for quite a few months now. Out of desperation I tried the following code:

Sub LoopThroughDirectory()

Dim MyFile As String
Dim erow
Filepath = "D:\Aircrew_Flying_Hour\"
MyFile = Dir(Filepath)


Do While Len(MyFile) > 0
If MyFile = "Master_Calculator.xlsm" Then
Exit Sub
End If


Workbooks.Open (Filepath & MyFile)


Range("F76 : U796").Copy
ActiveWorkbook.Close


erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
[COLOR=#0000ff]ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 16))[/COLOR]


MyFile = Dir


Loop
End Sub

But I am getting a run time error 9 for the line highlighted in blue. (is this code viable for my case!!)

Could you please modify your original solution for me! I have made some amendments to my files so the refreshed data are given below:

1. The folder name is Aircrew_Flying_Hour. Location> D:\Aircrew_Flying_Hour\.

2. Source file extensions are xlsx. (Source file number 18. Will increase by 1 in every year)

3. Sheet names with the input range are identical. Each source file is a consolidation of one individual year. All source files are identical. The source sheet name is Summary of the Year ("Sheet 16" of each source file).

4. The 16 columns have headers in row 76 starting column F going upto column U. The range that I want to copy to the destination file is F76:U796

5. Destination wordbook (named MASTER_CALCULATOR) has only one sheet named DATA ("Sheet 1") which will contain the same headers in row 2 starting at column B. The destination file is also located in the same folder with source files.

6. Summary of the Year sheets (source files) are locked with same password and the whole range is hidden.

Please ignore my post #16

 

[mumps]

Try this macro. For sorting purposes, the macro assumes the dates are in column G of the "DATA" sheet. Change the column in the code to suit your needs. Change "MyPassword" in the code to your actual password.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim lastRow As Long
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "D:\Aircrew_Flying_Hour\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        If wkbSource.Name <> ThisWorkbook.Name Then
            With wkbSource
                .Sheets("Summary of the Year").Unprotect Password:="MyPassword"
                .Sheets("Summary of the Year").Range("F77:U798").Copy wkbDest.Sheets("DATA").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
                .Close savechanges:=False
            End With
            strExtension = Dir
        End If
    Loop
    lastRow = wkbDest.Worksheets("DATA").Cells(Rows.Count, "C").End(xlUp).Row
    wkbDest.Worksheets("DATA").Sort.SortFields.Clear
    wkbDest.Worksheets("DATA").Sort.SortFields.Add Key:=Range("G2:G" & lastRow) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With wkbDest.Worksheets("DATA").Sort
        .SetRange Range("G1:G" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Application.ScreenUpdating = True
End Sub

What do you mean by

the whole range is hidden

 

[klutch]

I have a similar project that I am working on, I have data for specific products from a 3rd party software that is exporting data into excel for me. I am working to export this data (one cell) into a word document template that is specific to each product (file name is identical to product#) using macro. Is there a way to code excel so that the data will copy/paste into the specific file for that data? I am also trying to put the data into a specific location within the word doc.
Cell is J2
File path is Libraries\Documents and file name is Template.doc

 

[mumps]

@klutch: Welcome to the Forum. It is against Forum rules to post your question in another person's thread. Please start your own new thread.