Question

通过此代码，我可以复制工作表并重命名，但不能复制到所需（特定）工作表附近。或 我需要搜索该工作簿中已有的工作表以选择并复制到该工作表附近 。

复制工作表>复制所选工作表（Active.Sheet）>在工作表之前复制>选择所需的工作表（ActiveSheet.Copy Before :)要求工作表

Public Sub CopySheetAndRename()
    Dim newName As String

    On Error Resume Next
    newName = InputBox("Enter the name for the copied worksheet")

    If newName <> "" Then
        ActiveSheet.Copy After:=Worksheets(Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = newName
    End If
End Sub

我已经进行了这样的更改，但是我不知道哪一部分是错误的还是正确的

Public Sub CopySheetAndRename()
   Dim newName As String 
   On Error Resume Next 
   newName = InputBox("Enter the name for the copied worksheet") 

   If newName <> "" Then 
   On Error Resume Next newName1 = InputBox("Enter the name to copy before worksheet") 

   If newName1 <> "" Then ActiveSheet.Copy before:=Worksheets(Worksheets(newName1).Index) 

   On Error Resume Next 

   ActiveSheet.Name = newName 

   End If 

End Sub

已编辑^^^

我需要将此代码更改为sheet.name或搜索表

ActiveSheet.Copy After:=Worksheets(Sheets.Count)

我希望输出将复制具有重命名且靠近特定图纸的图纸（如果有3张图纸，例如Sheet1，Sheet2和Sheet3如果我复制图纸，则说sheet1并复制到图纸附近例如sheet3，那么它必须在sheet3之前复制。）

Answer 1

尝试一下：

ActiveSheet.Copy After:=Worksheets(Worksheets("desired (particular) sheet").Index)

将desired (particular) sheet替换为您在问题中所讨论的特殊工作表的名称。

此外，如果您想复制Before，只需将After替换为Before

而且，如果要复制特定的工作表而不是活动的工作表，请用ActiveSheet替换Worksheets("Nameofthatsheet")

更新＃2： OP需要重命名复制后创建的新工作表，因此新代码应如下所示：

Public Sub CopySheetAndRename()
Dim NewName As String
Dim SheetToCopy As String
Dim BeforeThisSheet As String
Dim wk As Worksheet
Dim WKexists As Boolean


Get_NewName:

NewName = InputBox("Enter the name for the new worksheet")

If Trim(NewName) = vbNullString Or Len(NewName) = 0 Or NewName = "" Then
    MsgBox "No name has been entered. Copy will be canceled", vbCritical, "ERROR"
    Exit Sub
Else
    For Each wk In ThisWorkbook.Worksheets
        If UCase(wk.Name) = UCase(NewName) Then
            MsgBox "The name entered already exists in this workbook. Please, type a different one", vbCritical, "ERROR"
            GoTo Get_NewName
        End If
    Next wk
End If

SheetToCopy = InputBox("Enter the name for the copied worksheet")

If SheetToCopy = vbNullString Or Len(SheetToCopy) = 0 Or SheetToCopy = "" Then
    Exit Sub
Else
    WKexists = False
    For Each wk In ThisWorkbook.Worksheets
        If UCase(wk.Name) = UCase(SheetToCopy) Then WKexists = True
    Next wk

    If WKexists = False Then
        MsgBox "There is not any worksheet with that name. Copy will be canceled", vbCritical, "ERROR"
        Exit Sub
    End If

End If


BeforeThisSheet = InputBox("Enter the name to copy before worksheet")

If BeforeThisSheet = vbNullString Or Len(BeforeThisSheet) = 0 Or BeforeThisSheet = "" Then
    Exit Sub
Else
    WKexists = False
    For Each wk In ThisWorkbook.Worksheets
        If UCase(wk.Name) = UCase(BeforeThisSheet) Then WKexists = True
    Next wk

    If WKexists = False Then
        MsgBox "There is not any worksheet with that name. Copy will be canceled", vbCritical, "ERROR"
        Exit Sub
    End If
End If

Worksheets(SheetToCopy).Copy before:=Worksheets(Worksheets(BeforeThisSheet).Index)

ActiveSheet.Name = NewName


End Sub

我必须承认，这不是最优雅的方法，但是它会起作用。

代码将要求3件事：

您要创建的新工作表的新名称

您要复制的工作表的名称

要使用新名称创建的副本之前要插入的工作表的名称

此外，代码还将确保您使用正确的工作表名称：

在步骤1中，它将检查新名称是否已经存在，因为工作簿不能有2个同名工作表。

在步骤2和3中，它将检查工作表的名称是否存在，因为它们必须存在于工作簿中。如果您键入   不存在的工作表的名称，该过程将被取消。

这是我能做的最好的事情。希望您能适应您的需求。

将图纸复制到特定的图纸附近并重命名

1 个答案: