Script to Recurse Directory, Open XL files, Copy Stuff etc....

**xlguy** · 03-14-2010, 05:29 PM

Hi All,

I was hoping someone here already has some script to help me achieve the following;

1. From within a specified folder (containing many Excel workbooks) open one w/b at a time
2. Copy a named range (from the file opened via this script) and "append" it to the last blank row in a (RawData) sheet in a master file that collects the data from all the files in the specified folder
3. Rename the sheet (from the file opened via this script) to a value from a cell (let's say "A1") in the sheet
4. Copy the sheet to the master file (at the end)
5. Close the file opened via script
6. Move it to a separate (Completed) folder
7. Open next file from specified folder
8. Repeat from step 2 above

Much thanks for any and all help in this regard. I know a bit of VBA, but not enough to complete this exercise.

Later,

C

**JBeaucaire** · 03-14-2010, 07:42 PM

Here's my stock macro for this task, edited for your task.

Option Explicit

Sub Consolidate()
'Open all Excel files in a specific folder and merge data into master sheet
'Moves imported files into another folder
'JBeaucaire (9/15/2009)     (2007 compatible)      EDITED: 3/13/2010
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wbNew As Workbook, ws As Worksheet

'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
    Set wbNew = ThisWorkbook
    wbNew.Activate

'Path and filename
    OldDir = CurDir                     'memorizes the users current working path
    fPath = "C:\2010\"                  'remember final \ in this string
    fPathDone = fPath & "Completed\"    'remember final \ in this string
    On Error Resume Next                'creates the completed folder if missing
        MkDir fPathDone
    On Error GoTo 0
    ChDir fPath
    fName = Dir("*.xls")

'Import a sheet from found file
    Do While Len(fName) > 0
        If fName <> wbNew.Name Then
        'Next row
            NR = wbNew.Sheets("RawData").Range("A" & Rows.Count).End(xlUp).Row + 1
        'Open file
            Set wbData = Workbooks.Open(fName)
        'Copy named range
            Range("NamedRange").Parent.Activate
            Range("NamedRange").Copy wbNew.Sheets("RawData").Range("A" & NR)
        'Rename activesheet and copy to master file
            ActiveSheet.Name = ActiveSheet.Range("A1")     'cell with text for sheet name
            ActiveSheet.Copy After:=wbNew.Sheets(wbNew.Sheets.Count)
        'close file without saving any changes to it
            wbData.Close False
        'move file to completed folder
            Name fPath & fName As fPathDone & fName
        End If
        'ready next filename
            fName = Dir
    Loop

'Cleanup
    wbNew.Sheets("RawData").Columns.AutoFit
    wbNew.Sheets("RawData").Rows.AutoFit
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

'restores original working path
    ChDir OldDir
End Sub

**xlguy** · 03-15-2010, 09:34 AM

JBeaucaire,

Thank a million!!! You are indeed a genius. Very kind of you to share your code with me....and even customizing it for my task.

I can't believe how well your code is written, laid out, and commented as well.

Great stuff indeed.

**JBeaucaire** · 03-15-2010, 02:28 PM

Glad to help. If that takes care of your need, please click EDIT in your original post, click GO ADVANCED and set the PREFIX box to SOLVED.

======
There's a link to my "files" in my signature, lots of other tools and samples you may find useful.

**xlguy** · 03-23-2010, 12:33 PM

Hi again,

I've only now tried running the script you provided me a couple of days back and I seem to be having some issues with it....so hoping you can help again.

Basically, I think the problem might lie in one (or both) of the following statements - which you'll towards the middle of the "Do While Len(fName) > 0" loop.

>> 'Copy named range
>> Range("NamedRange").Parent.Activate
>> Range("NamedRange").Copy wbNew.Sheets("RawData").Range("A" & NR)

The issue I'm having (or the behaviour I'm noticing) is that data from a range named "NamedRange" in my destination file itself i.e. wbNew/ThisWorkbook (or the workbook from which the macro is being run) is being copied....instead of data from a similarly named range in the source workbook i.e. wbData being copied.

Once again, appreciate any help received....and I'll close this issue as "RESOLVED" once I have this working.

Thanks.

**JBeaucaire** · 03-23-2010, 01:03 PM

Not sure how to troubleshoot that since it's didn't do that in my test. Simplest question...does removing the "similar name" in your master workbook fix the conflict?

**xlguy** · 03-23-2010, 01:59 PM

Ok, I found the problem....and maybe you might be able to provide me a good piece of code to resolve the issue.

Long story short: the copied range ("NamedRange") must be "pasted as values", rather than "as-is" - which is "as formulas".

Short story made long: what's happening is that when the range is copied from the source workbook, it's being copied with the formulas, and when it's being pasted into the destination workbook (as formulas, which are essentially cell references to a different sheet within the same destination workbook)...it looks as though the destination workbooks' range is being copied, when in fact it isn't.

So yeah, I just need to be able to paste the copied data as values.

Appreciate your help,

T.