Looping through Workbooks in a folder

I'd like to use the below macro to go into this Folder:

L:\RESEARCH\Alternative Assets\HedgeFunds\PackHedge\Documents\NEPC_Documents\Monitoring_Questionnaires

Open the 1st Work Book in the folder. Enable the Macros when the text box that asks this somes up. Copy and paste these cells from the 2nd WorkSheet in in the Work Book :F6,D14,D16,D18,D20,J14,J16,J18,J26:J32,J36:J38,F83,H83,J83,F85,H85,J85,F87,H87,J87,F104,F106,F108,F120,F122,F128,F130,F132,F136

The paste it into the 1st available row in this Workbook horizontally:
L:\RESEARCH\Alternative Assets\HedgeFunds\PackHedge\Documents\NEPC_Documents\Monitoring_Questionnaires\Log_Monitoring Questionnaire_063007.xls.

Then Go into the next WorkBook in the folder L:\RESEARCH\Alternative Assets\Hedge Funds\PackHedge\Documents\NEPC_Documents\Monitoring_Questionnaires and loop through the same process and pasting data in the next available row in the workbook L:\RESEARCH\Alternative Assets\HedgeFunds\PackHedge\Documents\NEPC_Documents\Monitoring_Questionnaires\Log_Monitoring Questionnaire_063007.xls.

It's not working for some reason. Please assist. Thanks.

Sub ExtractMonitoringQuestionnaireData()

'All the #1 variables are the source
'All the #2 variables are destination

    Dim EachFile As String 'Will be the name of each file to copy from
    Dim wb1 As Object ' wb1 will be set to each of the source files to copy from
    Dim wb2 As Workbook 'wb2 is the destination workbook (does not change)
    Dim sh1 As Worksheet 'sh1 will be the first sheet of each wb1 (source file)
    Dim sh2 As Worksheet 'sh2 is the first sheet of wb2 (destination file) ...also will not change
    Dim r2 As Range 'will be set to the next available row in wb2 (destination file)
   
    Dim DestFile As String 'Path and filename of destination file
    Dim SourcePath As String 'Path of folder containing files to copy from
   
   
   
Application.ScreenUpdating = False
Application.EnableEvents = False
   
   
    'Path and filename of file to paste to
    DestFile = "L:\RESEARCH\Alternative Assets\Hedge Funds\PackHedge\Documents\NEPC_Documents\Monitoring_Questionnaires\Log_Monitoring Questionnaire_063007.xls"
   
    'Path of files to open and copy from
    SourcePath = "L:\RESEARCH\Alternative Assets\Hedge Funds\PackHedge\Documents\NEPC_Documents\Monitoring_Questionnaires"


Set wb2 = Workbooks.Open(DestFile) 'Opens the destination file
Set sh2 = wb2.Sheets(1) ' set sh2 to the first sheet in wb2...change this to whatever sheet you
                        'want to paste to
Set r2 = sh2.Range("B1") ' set r2 to range("B1") of sh2 (sh2 is set in line above)

'Find first empty row in Column B (change B1 to A1 in line above if you want
'to use column A
Do Until r2.Value = ""
    Set r2 = r2.Offset(1, 0)
Loop



    ' Get filename of the first xls file.
    EachFile = Dir(SourcePath & "\*.xls")
   
    Do While EachFile <> ""   ' Start the loop.
     
     'This next line just checks to make sure that the file that is getting opened
     'to copy from is not the same one you are pasting to in case the one you are pasting to
     'is in the same folder as the ones you are copying from (which I assume it is)
     If EachFile = "HF Preliminary Manager Questionnaire Database (version 2.0).xls" Then GoTo nxt
       
        'Make EachFile = to the path and filename of the file to copy from
        EachFile = SourcePath & "\" & EachFile
     
        Set wb1 = GetObject(EachFile) 'Open EachFile
   
    Set sh1 = wb1.Sheets(2) 'sh is now the first sheet in wb1 (workbook to copy from)
       
        'copy the cells
        sh1.Range("F6,D14,D16,D18,D20,J14,J16,J18,J26:J32,J36:J38,F83,H83,J83,F85,H85,J85,F87,H87,J87,F104,F106,F108,F120,F122,F128,F130,F132,F136").Copy
       
        'paste to r2 which was set previously
        r2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
             
             'Find next empty row to paste to
             Do Until r2.Value = ""
                 Set r2 = r2.Offset(1, 0)
             Loop
     
     'Close wb1 without saving changes
     wb1.Close False
     

nxt:
       EachFile = Dir    ' Get next xls file
    Loop
   
wb2.Save 'Save wb2


Application.ScreenUpdating = True
Application.EnableEvents = True
   
   'Set all object variables to nothing
    Set wb1 = Nothing
    Set wb2 = Nothing
    Set sh1 = Nothing
    Set sh2 = Nothing
    Set r2 = Nothing
   

End SubStart Free Trial