[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 243
  • Last Modified:

Macro to extract data from files

Dear experts,

I have a folder on my laptop/Desktop, which has about 20 excel files in both 2003 and 2007 version. Each file has several sheets, but consistently named. Within each sheet there are several data arrays.

What i need is a macro which will do the following


1.      Go the folder and select each sheet at a time.
a.      The macro should have a location where i can feed the path
2.      When it selects the first file, the macro should seek a sheet
a.      The macro should have a location where i can feed the sheet name
3.      When it selects the target sheet, the macro should seek a range
4.      Then copy the range on to a new sheet.
5.      Close the current file from where the data has been copied
6.      Then open the next file and the repeat the steps 2 to 5,
7.      But macro should copy the range data adjacent to the range copied from file 1 and so on
8.      For example if we have copied data on the new sheet in column A:b, then the data from second file should be copied in range C;D and so on.

I should be able to change the range details of the data to be copied from the files. In other words, i need to be able to change the range details in the macro so that i can use it several times.


Thank you,
0
Excellearner
Asked:
Excellearner
  • 3
  • 2
1 Solution
 
hippohoodCommented:
The code below should do it for you. You have to define all the constants (input sheets directory, sheet name and ranges; output  workbook, shete and range to start). Every new copied range will be pasted to the right from previous. Let me know if you have any problem
Sub JustDoIt()

'
Const theDir = "P:\My Documents"
Const theSheet = "Sheet 1"
Const theRange = "A2:B10"
Const OutputWorkbook = "P:\My Documents\output.xlsx"
Const OutputSheet = "Sheet 1"
Const Output_StartRng = "A1"
    
Dim fs, f, f1, fc, s

Dim i%, c%
Dim outRange As Range
    ChDir theDir
    Workbooks.Open Filename:=OutputWorkbook
    Sheets(OutputSheet).Select
    
    Set outRange = Workbooks(OutputWorkbook).Worksheets(OutputSheet).Range(Output_StartRng)
    i = 0
        
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(theDir)
    Set fc = f.Files
    For Each f1 In fc
        Workbooks.Open Filename:=f1.Name
        Sheets(theSheet).Select
        Range(theRange).Copy
        c = Range(theRange).Columns.Count
        Workbooks(OutputWorkbook).Activate
        outRange.Offset(0, c * i).Select
        Workbooks(OutputWorkbook).Worksheets(OutputSheet).Paste
        Workbooks(f1.Name).Close
        i = i + 1
    Next
    
End Sub

Open in new window

0
 
ExcellearnerAuthor Commented:
Hi Hippo Hood,

Thank you for the vba query.

I changed the details as per the below:
Sub JustDoIt()

'
Const theDir = "C:\Documents and Settings\********\Desktop\consol"
Const theSheet = "OUTPUT"
Const theRange = "b3:e5"
Const OutputWorkbook = "C:\Documents and Settings\********\Desktop\consol\Macro\Data output.xlsx"
Const OutputSheet = "Sheet1"
Const Output_StartRng = "A1"
I got the below error also:

*****
'Run time error '1004':
Application-defined or object defined error
******

Also, can i request to amend the vba to copy the name of the sheet in row 1 from where the data is being copied.

Kindly help.

Doc1.doc
0
 
ExcellearnerAuthor Commented:
the solution was not complete.
0
 
hippohoodCommented:
Learner,

I could not come up with the answer to your other question so quickly. I t was weekend and I am in a different ime zone.

Do you stil need help?
0
 
ExcellearnerAuthor Commented:
Hi hippohood,

I still need help. I thought it was better to close the current question and put forward another question.

I also included a new condition in the new question i put forward. The reference number of the new question i have put is 27326878.

Hope you had a good weekend.

Yes i am desperately waiting for the solution.

Thank you
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now