VBA Macro to pull data from worksheet on several workbooks without opening files

Question

Hi Everyone,

I am a bit rusty with VBA and in need on some help.

I need to extract data from several workbooks in a file (called AIM Statistics) without opening any workbooks. Each workbook has several worksheets, but the data I need is from the worksheet called 'Trading by Security', which appears on every workbook. Ideally, I need the data pulled to fit a criteria (-that the value in column C is one of 6 specified values-) but I need only 2 corresponding columns (A and H) on the 'Trading by Security' worksheet to be transferred and compiled on a new open workbook I will be running the macro from.

I have trawled the internet for code but what I have found, I am unable to fit together in a way that works.

Could anybody shine any light on my problem? I hope I have made this clear to understand.

Any feedback would be much appreciated.

Thanks,

Millie

Answer 1

Take a look at Ron de Bruin's site.

Getting data from closed workbooks.

http://www.rondebruin.nl/win/s3/win024.htm

Gord

Answer 2

Hi,

If you are interested in a non macro solution, then you may want to try out the INDIRECT.EXT function to pull data from a closed workbook.  Here is a link - http://www.ashishmathur.com/extract-data-from-multiple-cells-of-closed-excel-files/

Hope this helps.

Answer 3

Thank you for this suggestion, however it does need to be a macro as it must be user friendly for other users. I've had a look and come to the conclusion it's not quite suitable.

Thanks again,

Millie

Answer 4

This link has helped me an awful lot! I'm just playing around with the code now to get it to how I want it. Thanks for your help!

Millie

Answer 5

Having been on that site, I still cannot get the macro open all of the workbooks in the folder, it will only open 1. Could you shine any light on why?  Here is my code

Sub Basic_Example_improved()

    Dim MyPath As String, FilesInPath As String

    Dim MyFiles() As String

    Dim SourceCcount As Long, Fnum As Long

    Dim mybook As Workbook, BaseWks As Worksheet

    Dim sourceRange As Range, destrange As Range

    Dim Cnum As Long, CalcMode As Long

'Fill in the path\folder where the files are

    MyPath = "C:\Users\Intern\Documents\Intern\Aim Statistics"

    'Add a slash at the end if the user forget it

    If Right(MyPath, 1) <> "" Then

        MyPath = MyPath & ""

    End If

'If there are no Excel files in the folder exit the sub

    FilesInPath = Dir(MyPath & "*.xl*")

    If FilesInPath = "" Then

        MsgBox "No files found"

        Exit Sub

    End If

'Fill the array(myFiles)with the list of Excel files in the folder

    Fnum = 0

    Do While FilesInPath <> ""

        Fnum = Fnum + 1

        ReDim Preserve MyFiles(1 To Fnum)

        MyFiles(Fnum) = FilesInPath

        FilesInPath = Dir()

    Loop

'Change ScreenUpdating, Calculation and EnableEvents

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

        .EnableEvents = False

    End With

  'Add a new workbook with one sheet

    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    Cnum = 1

'Loop through all files in the array(myFiles)

    If Fnum > 0 Then

        For Fnum = LBound(MyFiles) To UBound(MyFiles)

            Set mybook = Nothing

            On Error Resume Next

            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))

            On Error GoTo 0

            If Not mybook Is Nothing Then

                On Error Resume Next

                Set sourceRange = mybook.Worksheets("Trading by Security").Range(Columns(1), Columns(7))

                If Err.Number > 0 Then

                    Err.Clear

                    Set sourceRange = Nothing

                Else

                    'if SourceRange use all rows then skip this file

                    If sourceRange.Rows.Count >= BaseWks.Rows.Count Then

                        Set sourceRange = Nothing

                    End If

                End If

                On Error GoTo 0

                If Not sourceRange Is Nothing Then

                    SourceCcount = sourceRange.Columns.Count

                    If Cnum + SourceCcount >= BaseWks.Columns.Count Then

                        MsgBox "Sorry there are not enough columns in the sheet"

                        BaseWks.Columns.AutoFit

                        mybook.Close savechanges:=False

                        GoTo ExitTheSub

                    Else

                        'Copy the file name in the first row

                        With sourceRange

                            BaseWks.Cells(1, Cnum). _

                                    Resize(, .Columns.Count).Value = MyFiles(Fnum)

                        End With

                        'Set the destrange

                        Set destrange = BaseWks.Cells(2, Cnum)

                        'we copy the values from the sourceRange to the destrange

                        With sourceRange

                            Set destrange = destrange. _

                                            Resize(.Rows.Count, .Columns.Count)

                        End With

                        destrange.Value = sourceRange.Value

                        Cnum = Cnum + SourceCcount

                    End If

                End If

                mybook.Close savechanges:=False

            End If

        Next Fnum

        BaseWks.Columns.AutoFit

    End If

ExitTheSub:

    'Restore ScreenUpdating, Calculation and EnableEvents

    With Application

        .ScreenUpdating = True

        .EnableEvents = True

        .Calculation = CalcMode

    End With

End Sub