Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 276
Default Ron De Bruin Code modification needed when naming copied worksheet


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


  #2   Report Post  
Posted to microsoft.public.excel.programming
JMB JMB is offline
external usenet poster
 
Posts: 2,062
Default Ron De Bruin Code modification needed when naming copied worksheet

maybe mybook.name & " " & activesheet.name

"Corey" wrote:


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



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 276
Default Ron De Bruin Code modification needed when naming copied worksheet

Perfect.
Cheers
Corey....


"JMB" wrote in message
...
maybe mybook.name & " " & activesheet.name

"Corey" wrote:


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





Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Code Help for naming a worksheet tab Very Basic User Excel Discussion (Misc queries) 3 November 11th 09 12:21 PM
help with ron bruin site - preventing outlook secuirty help needed funkymonkUK[_159_] Excel Programming 3 May 11th 06 06:54 PM
Macro Compiles Sheets to One Book...Small Modification Needed TEAM[_7_] Excel Programming 1 September 15th 05 06:12 PM
Formula Modification Needed Phil Hageman[_3_] Excel Programming 4 December 18th 03 07:19 PM
Code for naming worksheet name range?? Sandy[_3_] Excel Programming 2 September 7th 03 04:49 AM


All times are GMT +1. The time now is 04:49 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"