T
Thomas
Hi,
This is my first post to any Group. Any help would be appreciated.
I have some excel VBA code that sets the current path of the main
workbook (BaseBook) and the loops through all .xls files in that path,
opens the file (FNames) and copies all non hidden worksheets to the
main workbook (BaseBook).
This works fine except the code (obviously) tries to re-open the main
workbook (BasebBook) at some point in the loop.
I need some help to test if the file about to be opened (FNames) is
the main workbook (BaseBook) and if so, skip to the next FNames file.
I know in simple terms how to do this but lack the VBA expreriance to
write this bit. I have never done a VBA course, but have picked up
many different things over the years.
I have gotten around this by saving Basebook with a file extension
like "workbnookname.aaa" I need to find a dynamic way of coding this
test, rather than fixing the file name as a fixed name.
Code is posted below: Problem in Part2:
Sub Testing()
Dim Basebook As Workbook
Dim Mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim Answer
Dim mySht As Variant
SaveDriveDir = CurDir 'Current file drive
Part1:
MyPath = ActiveWorkbook.Path ' File locations
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.AskToUpdateLinks = False
Application.ScreenUpdating = False
Part2:
Set Basebook = ThisWorkbook ' Main consolidation macro
Do While FNames <> "" ' Loop through *.xls files in
' current directory
' My poor attempt at testing the file name...
' just will not work.
' If Basebook.Name = FNames Then
' GoTo Part4
' Else: GoTo Part3
' End If
Part3:
Set Mybook = Workbooks.Open(FNames)
On Error Resume Next
'Worksheet Loop - Loops through visible sheets only
'
For Each mySht In ActiveWorkbook.Sheets
If mySht.Visible = True Then
mySht.Activate
mySht.Copy
after:=Basebook.Sheets(Basebook.Sheets.Count)
End If
Next mySht
On Error GoTo 0
Mybook.Close False
FNames = Dir()
Part4:
Loop
Part5:
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
Part6: 'Used to move the sheet order around to facilitate
consolidation formula
'Move Sheet to Front
Sheets("Consol").Move Before:=Sheets(1)
Sheets("First").Move Before:=Sheets(2)
'Move Sheet to End
Sheets("Last").Move after:=Sheets(Sheets.Count)
Finish:
ActiveWorkbook.Worksheets(1).Select
Calculate
End Sub
Any help would be appreciated.
Thanks again.
Thomas
This is my first post to any Group. Any help would be appreciated.
I have some excel VBA code that sets the current path of the main
workbook (BaseBook) and the loops through all .xls files in that path,
opens the file (FNames) and copies all non hidden worksheets to the
main workbook (BaseBook).
This works fine except the code (obviously) tries to re-open the main
workbook (BasebBook) at some point in the loop.
I need some help to test if the file about to be opened (FNames) is
the main workbook (BaseBook) and if so, skip to the next FNames file.
I know in simple terms how to do this but lack the VBA expreriance to
write this bit. I have never done a VBA course, but have picked up
many different things over the years.
I have gotten around this by saving Basebook with a file extension
like "workbnookname.aaa" I need to find a dynamic way of coding this
test, rather than fixing the file name as a fixed name.
Code is posted below: Problem in Part2:
Sub Testing()
Dim Basebook As Workbook
Dim Mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim Answer
Dim mySht As Variant
SaveDriveDir = CurDir 'Current file drive
Part1:
MyPath = ActiveWorkbook.Path ' File locations
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.AskToUpdateLinks = False
Application.ScreenUpdating = False
Part2:
Set Basebook = ThisWorkbook ' Main consolidation macro
Do While FNames <> "" ' Loop through *.xls files in
' current directory
' My poor attempt at testing the file name...
' just will not work.
' If Basebook.Name = FNames Then
' GoTo Part4
' Else: GoTo Part3
' End If
Part3:
Set Mybook = Workbooks.Open(FNames)
On Error Resume Next
'Worksheet Loop - Loops through visible sheets only
'
For Each mySht In ActiveWorkbook.Sheets
If mySht.Visible = True Then
mySht.Activate
mySht.Copy
after:=Basebook.Sheets(Basebook.Sheets.Count)
End If
Next mySht
On Error GoTo 0
Mybook.Close False
FNames = Dir()
Part4:
Loop
Part5:
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
Part6: 'Used to move the sheet order around to facilitate
consolidation formula
'Move Sheet to Front
Sheets("Consol").Move Before:=Sheets(1)
Sheets("First").Move Before:=Sheets(2)
'Move Sheet to End
Sheets("Last").Move after:=Sheets(Sheets.Count)
Finish:
ActiveWorkbook.Worksheets(1).Select
Calculate
End Sub
Any help would be appreciated.
Thanks again.
Thomas