Excel VBA Extracting data from other workbooks

[jmancha]

Good afternoon and Happy Friday!

I found and modified a macro many, many moons ago that takes the data from the first row and certain columns of a group of excel workbooks and creates one excel file with all of the data. It works FABULOUS however I do not really know how it works. I now need to extract the data from ONE cell on a sheet in about 500 workbooks BUT the data, unlike my current data, is not the first sheet in the workbook and I am lost. I am sure the macro has a place to specify which worksheet o look at but I cannot find it.

I have pasted the macro below and would appreciate any help!

[FONT=Cambria][SIZE=3][COLOR=#000000]Private Declare Function SetCurrentDirectoryA Lib _[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]   "jen20" (ByVal lpPathName As String) As Long[/COLOR][/SIZE][/FONT]


[FONT=Cambria][SIZE=3][COLOR=#000000]Sub ChDirNet(szPath As String)[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]   SetCurrentDirectoryA szPath[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]


[FONT=Cambria][SIZE=3][COLOR=#000000]Sub MergeSpecificWorkbooks()[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    Dim MyPath AsString[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    Dim SourceRcountAs Long, FNum As Long[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    Dim mybook AsWorkbook, BaseWks As Worksheet[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    Dim sourceRange AsRange, destrange As Range[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    Dim rnum As Long,CalcMode As Long[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    Dim SaveDriveDirAs String[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    Dim FName AsVariant[/COLOR][/SIZE][/FONT]


[FONT=Cambria][SIZE=3][COLOR=#000000]    ' Set applicationproperties.[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    With Application[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]        CalcMode =.Calculation[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]        .Calculation =xlCalculationManual[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]       .ScreenUpdating = False[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]        .EnableEvents= False[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    End With[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]    SaveDriveDir =CurDir[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    ' Change this tothe path\folder location of the files.[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    ChDirNet"U:\Test Folder"[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]    FName =Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*",_[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                                       MultiSelect:=True)[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    If IsArray(FName)Then[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]        ' Add a newworkbook with one sheet.[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]        Set BaseWks =Workbooks.Add(xlWBATWorksheet).Worksheets(1)[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]        rnum = 1[/COLOR][/SIZE][/FONT]


[FONT=Cambria][SIZE=3][COLOR=#000000]        ' Loop throughall files in the myFiles array.[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]        For FNum =LBound(FName) To UBound(FName)[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]            Set mybook= Nothing[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]            On ErrorResume Next[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]            Set mybook= Workbooks.Open(FName(FNum))[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]            On ErrorGoTo 0[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]            If Notmybook Is Nothing Then[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]                OnError Resume Next[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                Withmybook.Worksheets(1)[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                    Set sourceRange =.Range("A2:ZZ2")[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                EndWith[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]                IfErr.Number > 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                   Err.Clear[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                   Set sourceRange = Nothing[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                Else[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                    'If the source range uses all columns then[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                    'skip this file.[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                    IfsourceRange.Columns.Count >= BaseWks.Columns.Count Then[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       Set sourceRange = Nothing[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                   End If[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                End If[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                OnError GoTo 0[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]                If NotsourceRange Is Nothing Then[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]                   SourceRcount = sourceRange.Rows.Count[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]                    Ifrnum + SourceRcount >= BaseWks.Rows.Count Then[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       MsgBox "There are not enough rows in the target worksheet."[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       BaseWks.Columns.AutoFit[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       mybook.Close savechanges:=False[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       GoTo ExitTheSub[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                   Else[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]                       ' Copy the file name in column A.[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       With sourceRange[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                           BaseWks.Cells(rnum, "A"). _[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                                   Resize(.Rows.Count).Value = FName(FNum)[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       End With[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]                       ' Set the destination range.[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       Set destrange = BaseWks.Range("B" & rnum)[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]                       ' Copy the values from the source range[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       ' to the destination range.[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       With sourceRange[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                           Set destrange = destrange. _[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                                           Resize(.Rows.Count, .Columns.Count)[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       End With[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       destrange.Value = sourceRange.Value[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                       rnum = rnum + SourceRcount[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                   End If[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]                End If[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]               mybook.Close savechanges:=False[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]            End If[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]        Next FNum[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]       BaseWks.Columns.AutoFit[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]

[FONT=Cambria][SIZE=3][COLOR=#000000]ExitTheSub:[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    ' Restore theapplication properties.[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    With Application[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]       .ScreenUpdating = True[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]        .EnableEvents= True[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]        .Calculation =CalcMode[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    End With[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]    ChDirNetSaveDriveDir[/COLOR][/SIZE][/FONT]
[FONT=Cambria][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]