Solved: combine all workbook

hi all,

i got this macro from here
http://www.vbaexpress.com/forum/newt...newthread&f=17
Option Explicit

Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "C:\" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub
if i run this, all worksheet in all book will get copied.
can someone change the code, so only sheet1 will get copy...

thanks

reza

Try:

Code:

---

Sub exa()
Dim fsoFile As Object
Dim wks As Worksheet
   
'//                        Change to suit                                          //
Const FILEPATH As String = "G:\2010\_Tmp\2010-08-30"
   
    With CreateObject("Scripting.FileSystemObject")
        If .FolderExists(FILEPATH) Then
            For Each fsoFile In .GetFolder(FILEPATH).Files
                If fsoFile.Type = "Microsoft Excel Worksheet" Then
                    Set wks = Workbooks.Open(fsoFile.Path, , True).Worksheets(1)
                    wks.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                    wks.Parent.Close False
                End If
            Next
        End If
    End With
End Sub

---

Hope that helps,

Mark