复制表并改名

ddz79101

老师！有簿含多表，其中部分表隐藏。我想在隐藏表的情况下，复制表并改名。现有代码，但在有隐藏表情况下，虽复制，但改不了名。请老师看看。谢谢

重发附件，复制并改名2

gwjkkkkk

.................

ddz79101

gwjkkkkk 发表于 2024-12-15 12:18
.................

谢谢老师！运行成功

ddz79101

gwjkkkkk 发表于 2024-12-15 12:18
.................

抱歉！老师原的附件有问题。未在《CCC》表中输入数据。使得新增表未显示复制粘贴数据。老师能否再看看。谢谢

ykcbf1100

ddz79101 发表于 2024-12-15 14:41
抱歉！老师原的附件有问题。未在《CCC》表中输入数据。使得新增表未显示复制粘贴数据。老师能否再看看。 ...

这个在有隐藏工作表时直接改名会出错。
我目前只能想到一个笨办法，就是先把隐藏表取消隐藏，然后，工作表复制改名，最后，再把原隐藏表再隐藏回去。

ykcbf1100

工作表复制并改名（有隐藏表情况下）。

1. Sub 复制表并改名()  '//2024.12.15
   
2.     Dim ss$
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     ReDim Zrr(1 To 100)
   
6.     For Each sht In Sheets
   
7.         If sht.Visible <> -1 Then
   
8.             sht.Visible = -1
   
9.             m = m + 1
   
10.             Zrr(m) = sht.Name
    
11.         End If
    
12.     Next
    
13.     sheetName = "CCC"
    
14.     ' 检查工作表是否存在
    
15.     On Error Resume Next
    
16.     Set ws = ThisWorkbook.Sheets(sheetName)
    
17.     On Error GoTo 0
    
18.     ' 如果工作表不存在，则退出宏
    
19.     If ws Is Nothing Then
    
20.         MsgBox "工作表 '" & sheetName & "' 不存在。"
    
21.         Exit Sub
    
22.     End If
    
23.     ss = InputBox("请输入改表名称：", "提示", "1")
    
24.     ws.Copy After:=Sheets(Sheets.Count)
    
25.     With Sheets(Sheets.Count)
    
26.         .Name = CStr(ss)
    
27.         .Tab.ColorIndex = 34
    
28.     End With
    
29.     For i = 1 To m
    
30.         Sheets(Zrr(i)).Visible = 0
    
31.     Next
    
32.     Application.ScreenUpdating = True
    
33.     Application.DisplayAlerts = True
    
34. End Sub
    

复制代码