Excel不会使用vba代码重命名工作表

我正在尝试将工作簿名Source.xlsm的sheet1复制到工作簿名s.xlsx。然后将复制的图纸重命名为列值，如D1。 我的代码正确复制了工作表，但重命名时出错

不是显示消息名称已退出，而是转到else部分并给出错误：运行时错误“1004”：无法将工作表重命名为另一个工作表的名称。并且这张行表.Name=rangeD1高亮显示

请纠正我做错了什么

我的代码是：

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("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")
            End If
          Next

End Sub

---

更改了代码并解决了问题。以下是参考代码：

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

---

谢谢大家的帮助……干杯

您的范围1不是每张工作表上的范围1。在循环浏览wbPath1中的工作表时，请提供正确的父工作表引用。如果工作表名称已存在，则希望调用复制的工作表？或者您想将其默认为自动生成的名称，例如sheet4？@Alex现在我只想，此代码显示消息框，通知sheet name已退出并退出sub.@Jeeped:如果sheet.name=rangeD1，则您想更改此代码行。如果Sheet.Name=WorkbooksCash Loading.xlsm.SheetsSheet1.rangeD1，我会用这一行更改它，但仍然没有运气。请你详细说明你的意思好吗？试着把rangeD1改为rangeD1.value。通过将此范围指定给已经存在的变量decard:wsName=rangeD1.value来跟踪错误甚至更好。并确保引用的工作簿和工作表正确。因此，扩展代码应该是：wsName=workbooksource.xlsm.sheets1.rangeD1.value