PDA

View Full Version : Problem Importing Files



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

mdmackillop
11-29-2009, 10:21 AM
Try this

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
Dim MyFileSearch As String


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 = Dir(My_Path & "*.xlsx")
Do Until MyFileSearch = ""
'Open each Workbook and Set a Workbook variable to it
If Trim(UCase(MyFileSearch)) <> Trim(UCase(wbCodeBook.Name)) Then 'dont load myself by accident
Set wbResults = Workbooks.Open(My_Path & MyFileSearch, 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

MyFileSearch = Dir
Loop
my_reset:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

End Sub