balkishan
11-29-2009, 05:34 AM
Hello,
Could you please help me out.I'm using Excel 2007 and stuck in importing 23 Excel Datafiles called " Data for State1.xlsx",....."Data for State23.xlsx" .All datafiles are in .xlsx form into a single Excel datafile called " Import.xlsx".All 24 datafiles are placed in a sigle folder called Excel
Sub Open_Workbooks_Sheets()
Dim lCount As Long
Dim wbCodeBook As Workbook
Dim wbResults As Workbook
Dim My_Path As String
Dim Temp_Sheet As Worksheet
My_Path = InputBox("Enter Path to xlsx Files (cancel to back out):", "Path", "C:\Temp\")
If Trim(My_Path) = "" Then Exit Sub
If Right(My_Path, 1) <> "\" Then My_Path = My_Path & "\"
If Trim(Dir(My_Path)) = "" Then MsgBox "Bad path": Exit Sub
On Error GoTo my_reset
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wbCodeBook = ThisWorkbook
myFileSearch myDir:=My_Path, FileNameLike:="*", FileTypeLike:="xlsx", SearchSubFol:=True, myCounter:=0
For lCount = LBound(myList) To UBound(myList) ' Loop through all workbooks
'Open each Workbook and Set a Workbook variable to it
If Trim(UCase(myList(lCount))) <> Trim(UCase(wbCodeBook.Name)) Then 'dont load myself by accident
Set wbResults = Workbooks.Open(Filename:=myList(lCount), UpdateLinks:=0)
End If
'copy each sheet into the current book.
For Each Temp_Sheet In wbResults.Worksheets
Temp_Sheet.Copy after:=wbCodeBook.Worksheets(wbCodeBook.Worksheets.Count)
Next
'close workbook
wbResults.Close SaveChanges:=False
Next lCount
'turn on filtering.
my_reset:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
Thanks and Regards
Bal
Could you please help me out.I'm using Excel 2007 and stuck in importing 23 Excel Datafiles called " Data for State1.xlsx",....."Data for State23.xlsx" .All datafiles are in .xlsx form into a single Excel datafile called " Import.xlsx".All 24 datafiles are placed in a sigle folder called Excel
Sub Open_Workbooks_Sheets()
Dim lCount As Long
Dim wbCodeBook As Workbook
Dim wbResults As Workbook
Dim My_Path As String
Dim Temp_Sheet As Worksheet
My_Path = InputBox("Enter Path to xlsx Files (cancel to back out):", "Path", "C:\Temp\")
If Trim(My_Path) = "" Then Exit Sub
If Right(My_Path, 1) <> "\" Then My_Path = My_Path & "\"
If Trim(Dir(My_Path)) = "" Then MsgBox "Bad path": Exit Sub
On Error GoTo my_reset
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wbCodeBook = ThisWorkbook
myFileSearch myDir:=My_Path, FileNameLike:="*", FileTypeLike:="xlsx", SearchSubFol:=True, myCounter:=0
For lCount = LBound(myList) To UBound(myList) ' Loop through all workbooks
'Open each Workbook and Set a Workbook variable to it
If Trim(UCase(myList(lCount))) <> Trim(UCase(wbCodeBook.Name)) Then 'dont load myself by accident
Set wbResults = Workbooks.Open(Filename:=myList(lCount), UpdateLinks:=0)
End If
'copy each sheet into the current book.
For Each Temp_Sheet In wbResults.Worksheets
Temp_Sheet.Copy after:=wbCodeBook.Worksheets(wbCodeBook.Worksheets.Count)
Next
'close workbook
wbResults.Close SaveChanges:=False
Next lCount
'turn on filtering.
my_reset:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub
Thanks and Regards
Bal