PDA

View Full Version : Solved: combine all workbook



reza_doang
08-31-2010, 11:56 PM
hi all,

i got this macro from here
http://www.vbaexpress.com/forum/newthread.php?do=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

GTO
09-01-2010, 04:36 AM
Try:


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