Macro to choose folder and cycle through all files

Thanks in advance.

I have a workbook that contains many control charts and currently it requires someone to open each file in a folder to enter all the data into the workbook using a hot-key'd macro. I'd like to be able to cut down the work involved and just have the user choose the folder so that a similar macro could copy all the data into the workbook where the macros already in place would be able to compile it.

While I've seen may similar questions on this forum. This code http://www.excelforum.com/forum-rule...rum-rules.htmlappears to be what I believe I need,so I've altered it to my needs.


I'm not sure why the code below will not work:

Sub Runfolder()

Dim screenUpdateState       As Variant
Dim statusBarState          As Variant
Dim eventsState             As Variant
Dim fso                     As Object
Dim fPath                   As String
Dim myFolder, myFile
Dim wb                      As Workbook
Dim SavePath                As String
Dim I, x                    As Integer
Dim ws                      As Worksheet

' Turn off some Excel functionality so your code runs faster
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    eventsState = Application.EnableEvents

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False

' Use File System Object to choose folder with files
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then fPath = .SelectedItems(1) & "\"
    End With

' Open each file consequently
        Set myFolder = fso.GetFolder(fPath).Files
            For Each myFile In myFolder
                If LCase(myFile) Like "*.xls*" Then
                    For I = 1 To x

' Perform tasks with each file
                        Set wb = Workbooks.Open(myFile)
                        With wb.Worksheets("summary")
      'my changes
      Sheets("Summary").Select
     Cells.Select
    Selection.Copy
    Windows("Stats2011.xlsm").Activate
    Sheets("Paste").Select
    Cells.Select
    ActiveSheet.Paste
                           
                            
                            
                        End With
                        
                 
                       
                        ' Close file
                        wb.Close True

' Loop through all files in folder
                    Next I
                End If
            Next myFile

'clean up
    myFile = vbNullString
    I = 1

' Turn Excel functionality back on
    Application.ScreenUpdating = screenUpdateState
    Application.DisplayStatusBar = statusBarState
    Application.EnableEvents = eventsState

End Sub

It is not working because you have:

For I = 1 To x

But you have not given x a value. So you are saying

For I = 1 To 0

I cleaned up your code below and removed the For I = 1 to x, because I don't see the need for it. You are already looping through each file with "For Each myFile in MyFolder"

Sub Runfolder()

Dim screenUpdateState       As String
Dim statusBarState          As String
Dim eventsState             As String
Dim fso                     As Object
Dim fPath                   As String
Dim myFolder                As Variant
Dim myFile                  As Variant
Dim wb                      As Workbook
Dim SavePath                As String
Dim ws                      As Worksheet

' Turn off some Excel functionality so your code runs faster
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    eventsState = Application.EnableEvents

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False

' Use File System Object to choose folder with files
    Set fso = CreateObject("Scripting.FileSystemObject")

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            fPath = .SelectedItems(1) & "\"
        End If
    End With

' Open each file consequently
        Set myFolder = fso.GetFolder(fPath).Files
            For Each myFile In myFolder
                If LCase(myFile) Like "*.xls*" Then
' Perform tasks with each file
                    Set wb = Workbooks.Open(myFile)
                    Workbooks(myFile.Name).Sheets("Summary").Cells.Copy Workbooks("Stats2011.xlsm").Sheets("Paste").Cells
                    ' Close file
                    wb.Close True
                End If
' Loop through all files in folder
            Next myFile

'clean up
    myFolder = vbNullString
    myFile = vbNullString

' Turn Excel functionality back on
    Application.ScreenUpdating = screenUpdateState
    Application.DisplayStatusBar = statusBarState
    Application.EnableEvents = eventsState

End Sub

Also, I would change the task you perform with each sheet. The way it is now, you copy the entire Summary sheet and paste it into the Paste sheet... But then this gets repeated for each workbook. This means that, in effect, only the last workbook Summary sheet values will remain in the Paste sheet. Everything else gets overwritten with each loop.

Sub Runfolder()
  with Application
    .ScreenUpdating = False
    .EnableEvents = False

    c00 = .GetOpenFilename("*.xls, *.xls")
 
    for each fl in CreateObject("Scripting.FileSystemObject").getfolder(Replace(c00, Dir(c00), "")).files
      if instr(right(fl.name,4),"xls")>0 then
        with getobject(fl)
          .sheets("summary").usedrange.copy  Workbooks(("Stats2011.xlsm").Sheets("Paste").cells(1)      
          .close false
        End With
      end if
    next

    .EnableEvents = true
  end with
End Sub