Excel not renaming the copied sheet if name already exits

[Aman Chalotra]

I have written below code but its not working as required:
My requirement is:
Copy Sheet1 of Source.xlsm workbook to another workbook, s.xlsx and then rename the copied worksheet to value of D1 cell of this sheet. If sheet name of same name do not exists then it should rename and if name exits it should go to else condition, prompt an input box asking for new name and then rename accordingly.
My code is giving Run-time error '1004': Can not rename a sheet to name as of another sheet. And this line Sheet.Name = range("D1") of else condition is highlighted.
Here my code:

Sub savesheet()        
   
    Dim sPath As String
    
    Dim wbPath1 As Workbook
    Dim wsName As String
       
    sPath = Application.ActiveWorkbook.Path & "\s\s.xlsx"
    
                    
            Set wbPath1 = Workbooks.Open(sPath)
                   
            Workbooks("Cash Loading.xlsm").Sheets("Sheet1").Copy After:=wbPath1.Sheets(1)
          
            For Each Sheet In Workbooks("s.xlsx").Sheets
                If Not Sheet.Name = range("D1") Then
                    Sheet.Name = range("D1")
                                
                Else
                   wsName = InputBox("Name already exits,Please enter new name")
                   Sheet.Name = wsName
                End If
              Next
                      
End Sub

 

[mumps]

Try:

Sub savesheet()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim sPath As String
    Dim wbPath1 As Workbook
    Dim wsName As String
    sPath = Application.ActiveWorkbook.Path & "\s\s.xlsx"
    Set wbPath1 = Workbooks.Open(sPath)
    Workbooks("Cash Loading.xlsm").Sheets("Sheet1").Copy after:=wbPath1.Sheets(1)
    Set ws = Nothing
    On Error Resume Next
    Set ws = Worksheets(Range("D1").Value)
    On Error GoTo 0
    If ws Is Nothing Then
        ActiveSheet.Name = Range("D1").Value
    Else
        wsName = InputBox("Name already exits.  Please enter new name.")
        ActiveSheet.Name = wsName
    End If
    Application.ScreenUpdating = True
End Sub

 

[Aman Chalotra]

No still not working. I have changed the code a bit but still no luck. Please see and help.

Sub savesheetsub()




Dim sPath As String


Dim wbPath1 As Workbook
Dim wsName As String


    sPath = Application.ActiveWorkbook.Path & "\s\s.xlsx"


       Set wbPath1 = Workbooks.Open(sPath)




        Workbooks("Source.xlsm").Sheets("Sheet1").Copy after:=wbPath1.Sheets(Sheets.Count)


        'For Each Sheet In ActiveWorkbook.Sheets
        For Each Sheet In Workbooks("s.xlsx").Sheets
            If Sheet.Name = Workbooks("Source.xlsm").Sheets("Sheet1").range("D1") Then
             MsgBox "name already exits"
              Exit Sub


             Else
                 Sheet.Name = Workbooks("Source.xlsm").Sheets("Sheet1").range("D1")
            End If
          Next
        
End Sub

 

[mumps]

I tried the code I suggested on some dummy data and it worked properly. Can you explain in detail how my code is not working? Are you getting any error messages?

 

[Aman Chalotra]

I tried the code I suggested on some dummy data and it worked properly. Can you explain in detail how my code is not working? Are you getting any error messages?

@mumps appreciate your effort but I think My requirement is bit different.

I have to copy sheet1 of Source.xlsm workbook s.xlsx workbook.
Then rename the copied worksheet based on the value of DI cell of sheet1 of Source.xlsm

And if same name sheet already exist in s.xlsx system should prompt a msg box that sheet name already exist and then exit sub

Your code is giving the error Run time error 1004: Can not rename the sheet as to name of another name. A reference object library or a workbook reference by visual basic.


I have changed my code further and but still no luck, I am stick here since last 10 hours.

New Code

Dim sPath As String    Dim wbPath1 As Workbook
    Dim d1 As Long
    
    d1 = Workbooks("Source.xlsm").Sheets("Sheet1").range("D1").value
       sPath = Application.ActiveWorkbook.Path & "\s\s.xlsx"


       Set wbPath1 = Workbooks.Open(sPath)


        Workbooks("Source.xlsm").Sheets("Sheet1").Copy after:=wbPath1.Sheets(Sheets.Count)
        
        'For Each Sheet In ActiveWorkbook.Sheets
        For Each Sheet In Workbooks("s.xlsx").Sheets
           
            If Sheet.Name = d1 Then
             MsgBox "name already exits"
              Exit Sub


             Else
                 Sheet.Name = d1
            End If
          Next
End Sub

 

[mumps]

Is the value of Range("D1") a number?

 

[Aman Chalotra]

Is the value of Range("D1") a number?

Mostly it will be number but to cover the data type aspect changed it to String.

I have changed the else condition, This condition was causing problems Sheet.Name = range("D1") as it was trying to rename each sheet. Changed it with Sheets(Sheets.Count).Name = d1.

So the last sheet copied gets renamed with d1 cell value, but due to some reason code is looping back to if condition and displays. Dont know why. Can you figure it out ?

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">Dim sPath As String

Dim wbPath1 As Workbook
Dim wsName As String

sPath = Application.ActiveWorkbook.Path & "\s\s.xlsx"


Set wbPath1 = Workbooks.Open(sPath)


Workbooks("Source.xlsm").Sheets("Sheet1").Copy After:=wbPath1.Sheets(1)

'For Each Sheet In ActiveWorkbook.Sheets
For Each Sheet In Workbooks("s.xlsx").Sheets
If Sheet.Name = range("D1") Then
MsgBox "name already exits"
Exit Sub

Else
'Sheet.Name = range("D1")
Sheets(Sheets.Count).Name = d1

End If
Next

End Sub</code>

 

[mumps]

This code works for me if D1 is a number because you have defined d1 a long. Instead of changing it to String, try changing it to Variant. I suggest you try my version of the code as it doesn't use a loop.

Sub savesheet()
    Application.ScreenUpdating = False
    Dim sPath As String
    Dim wbPath1 As Workbook
    Dim d1 As Long
    Dim ws As Worksheet
    d1 = Workbooks("Source.xlsm").Sheets("Sheet1").Range("D1").Value
    sPath = Application.ActiveWorkbook.Path & "\s\s.xlsx"
    Set wbPath1 = Workbooks.Open(sPath)
    Workbooks("Source.xlsm").Sheets("Sheet1").Copy after:=wbPath1.Sheets(Sheets.Count)
    Set ws = Nothing
    On Error Resume Next
    Set ws = Worksheets(d1)
    On Error GoTo 0
    If ws Is Nothing Then
        ActiveSheet.Name = d1
    Else
        wsName = InputBox("Name already exits.  Please enter new name.")
        ActiveSheet.Name = wsName
    End If
    Application.ScreenUpdating = True
End Sub

 

[Aman Chalotra]

This code works for me if D1 is a number because you have defined d1 a long. Instead of changing it to String, try changing it to Variant. I suggest you try my version of the code as it doesn't use a loop.

Sub savesheet()
    Application.ScreenUpdating = False
    Dim sPath As String
    Dim wbPath1 As Workbook
    Dim d1 As Long
    Dim ws As Worksheet
    d1 = Workbooks("Source.xlsm").Sheets("Sheet1").Range("D1").Value
    sPath = Application.ActiveWorkbook.Path & "\s\s.xlsx"
    Set wbPath1 = Workbooks.Open(sPath)
    Workbooks("Source.xlsm").Sheets("Sheet1").Copy after:=wbPath1.Sheets(Sheets.Count)
    Set ws = Nothing
    On Error Resume Next
    Set ws = Worksheets(d1)
    On Error GoTo 0
    If ws Is Nothing Then
        ActiveSheet.Name = d1
    Else
        wsName = InputBox("Name already exits.  Please enter new name.")
        ActiveSheet.Name = wsName
    End If
    Application.ScreenUpdating = True
End Sub

Changed the code and its working now .Below is the code.
Have to modify more so I will keep posting.

Thanks for help mumps

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">Sub movesheet3()
Dim name As String
Dim sPath As String
Dim wbPath1 As Workbook

name = Workbooks("Source.xlsm").Sheets("Sheet1").range("D1").value


sPath = Application.ActiveWorkbook.Path & "\s\s.xlsx"

Set wbPath1 = Workbooks.Open(sPath)
wbPath1.Activate
'Workbooks("Source.xlsm").Sheets("Sheet1").Copy After:=wbPath1.Sheets(Sheets.Count)

For i = 1 To (Worksheets.Count)


If ActiveWorkbook.Sheets(i).name = name Then

MsgBox "Sheet name already exist. GO back to the sheet and enter valid name in D1 cell"

Exit Sub
End If

Next
Workbooks("Source.xlsm").Sheets("Sheet1").Copy After:=wbPath1.Sheets(Sheets.Count)

Sheets(ActiveSheet.name).name = name
ActiveWorkbook.Close True

End Sub</code>