Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Code Help for naming a worksheet tab | Excel Discussion (Misc queries) | |||
help with ron bruin site - preventing outlook secuirty help needed | Excel Programming | |||
Macro Compiles Sheets to One Book...Small Modification Needed | Excel Programming | |||
Formula Modification Needed | Excel Programming | |||
Code for naming worksheet name range?? | Excel Programming |