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.... |
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.... |
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.... |
All times are GMT +1. The time now is 04:53 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com