Ron De Bruin Code modification needed when naming copied worksheet

[Corey]

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....

 

[JMB]

maybe mybook.name & " " & activesheet.name

 

[Corey]

Perfect.
Cheers
Corey....

maybe mybook.name & " " & activesheet.name

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....