LinkBack URL
About LinkBacks
In the below code, which searches and copies any sheets in all workbooks in
a designated folder, I get an error and the searched workbook will not
automatically close because:
If there is 1 sheet in a workbook searched, the specific worksheet is copied
into the search excel workbook, and the new worksheet is
named(ActiveSheet.Name = mybook.Name) the workbook name that it is in. But
when MORE than 1 worksheet is found, because the new copied worksheet name
is already used, i get an error.
Below is where the naming of the copied sheet occurs.
What i would like to do is have the name of the sheet named:
[filename+sheetname] (ActiveSheet.Name = mybook.Name And mysheet.Name)???
Currently i get the filename, but want to add the sheet name also, so i then
do not get the error mentioned above.
How can i add this to the naming code line?
Sub ExampleTest()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
Dim input1 As String
Dim input2 As String
input1 = Application.InputBox("Enter The CUSTOMER Name", "Title of msg
box..")
input2 = Application.InputBox("Enter The Customer's CONVEYOR Name",
"Title of msg box..")
SaveDriveDir = CurDir
MyPath = "\\Office2\my documents\Costing Sheets"
' 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.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
On Error Resume Next
Dim i As Integer
mybook.Activate
For i = 2 To Sheets.Count
If mybook.Worksheets(i).Range("B3").Value = input1 And
mybook.Worksheets(i).Range("D3").Value = input2 Then
mybook.Worksheets(i).Copy
After:=basebook.Sheets(basebook.Sheets.Count)
ActiveSheet.Name = mybook.Name ' <============= Error here,
due to (If) more than 2 sheets found, as the copied sheet is named the
workbook name
On Error GoTo 0
End If
Next
mybook.Close savechanges:=False
' mybook.Close False
FNames = Dir()
' ChDrive SaveDriveDir
' ChDir SaveDriveDir
Application.ScreenUpdating = True
Loop
End Sub
Regards
Corey....
Register To Reply
Bookmarks