Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/23.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel VBA:复制图纸mantain定义的名称_Excel_Vba - Fatal编程技术网

Excel VBA:复制图纸mantain定义的名称

Excel VBA:复制图纸mantain定义的名称,excel,vba,Excel,Vba,我有一个定义了名称的excel工作表,我想用VBA复制它,同时复制定义的名称。我该怎么办 复制工作表的当前宏: Sub myMacro() Const BASE_NAME As String = "MySheet" Dim sheet_name As String Dim i As Integer Dim num_text As String Dim new_num As Integer Dim max_num As Integer Dim new_sheet As Worksheet ' F

我有一个定义了名称的excel工作表,我想用VBA复制它,同时复制定义的名称。我该怎么办

复制工作表的当前宏:

Sub myMacro()
Const BASE_NAME As String = "MySheet"
Dim sheet_name As String
Dim i As Integer
Dim num_text As String
Dim new_num As Integer
Dim max_num As Integer
Dim new_sheet As Worksheet

' Find the largest number in a sheet name after the
' base name.
max_num = 0
For i = 1 To Sheets.Count
    sheet_name = Sheets(i).Name
    If Left$(sheet_name, Len(BASE_NAME)) = BASE_NAME _
        Then
        num_text = Mid$(sheet_name, Len(BASE_NAME) + 1)
        new_num = Val(num_text)
        If new_num > max_num Then max_num = new_num
    End If
Next i

' Make a new sheet with a new number.
Set new_sheet = Sheets.Add(after:=Sheets(Sheets.Count))
new_sheet.Name = BASE_NAME & Format$(max_num + 1)
new_sheet.Select
Sheets("MySheet_template").Range("A1:DQ1109").Copy 

Destination:=Sheets(new_sheet.Name).Range("A1")
End Sub

试试这个——一个稍微不同的方法

Sub myMacro()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim sh As Shape, strtSh As Worksheet
    Set strtSh = ActiveSheet
    Sheets("MySheet_template").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "MySheet" & Sheets.Count - 1
    For Each sh In ActiveSheet.Shapes
        sh.Delete
    Next sh
    strtSh.Select
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

看一看,看看这是否有帮助。事实上,我无法解决。我无法复制工作表并保留其定义的名称。