Hello everyone I have this code but i keep getting Automation error. what Im tritng to accomplish is a marco that will copy worksheets into a summary and not remove the source in the orginal file
All my workbook have data all on sheet one all have the same headings all. and all in the same folder Someone please help...
Option Explicit
'Combine Workbooks
Sub CombineWorkbooks()
Dim CurFile As String, DirLoc As String
Dim DestWb As Workbook
Dim ws As Object 'allows for different sheet types
DirLoc = ThisWorkbook.path & "\tst\" 'location of files
CurFile = Dir(DirLoc & "*.xls")
Application.ScreenUpdating = False
Application.EnableEvents = False
Set DestWb = Workbooks.Add(xlWorksheet)
Do While CurFile <> vbNullString
Dim OrigWb As Workbook
Set OrigWb = Workbooks.Open(filename:=DirLoc & CurFile, ReadOnly:=True)
' Limit to valid sheet names and remove .xls*
CurFile = Left(Left(CurFile, Len(CurFile) - 5), 29)
For Each ws In OrigWb.Sheets
ws.Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
If OrigWb.Sheets.Count > 1 Then
DestWb.Sheets(DestWb.Sheets.Count).Name = CurFile & ws.Index
Else
DestWb.Sheets(DestWb.Sheets.Count).Name = CurFile
End If
Next
OrigWb.Close SaveChanges:=False
CurFile = Dir
Loop
Application.DisplayAlerts = False
DestWb.Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Set DestWb = Nothing
End Sub
All my workbook have data all on sheet one all have the same headings all. and all in the same folder Someone please help...
Option Explicit
'Combine Workbooks
Sub CombineWorkbooks()
Dim CurFile As String, DirLoc As String
Dim DestWb As Workbook
Dim ws As Object 'allows for different sheet types
DirLoc = ThisWorkbook.path & "\tst\" 'location of files
CurFile = Dir(DirLoc & "*.xls")
Application.ScreenUpdating = False
Application.EnableEvents = False
Set DestWb = Workbooks.Add(xlWorksheet)
Do While CurFile <> vbNullString
Dim OrigWb As Workbook
Set OrigWb = Workbooks.Open(filename:=DirLoc & CurFile, ReadOnly:=True)
' Limit to valid sheet names and remove .xls*
CurFile = Left(Left(CurFile, Len(CurFile) - 5), 29)
For Each ws In OrigWb.Sheets
ws.Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
If OrigWb.Sheets.Count > 1 Then
DestWb.Sheets(DestWb.Sheets.Count).Name = CurFile & ws.Index
Else
DestWb.Sheets(DestWb.Sheets.Count).Name = CurFile
End If
Next
OrigWb.Close SaveChanges:=False
CurFile = Dir
Loop
Application.DisplayAlerts = False
DestWb.Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Set DestWb = Nothing
End Sub