帮我看下怎么改

shenzhenyang

cjjhpc 发表于 2021-5-12 21:15
在我电脑是测试没任何问题

Sheets(Array("Sheet12", "Sheet13", "Sheet14")).Copy   我知道，这样改还是已标签命名，    我要去不是按这个标签名字，   我刚才一直不行是标签名改了对不上。

shenzhenyang

cjjhpc 发表于 2021-5-12 20:49
你不就是想复制这三个表吗?

要对应的是这个工作表名，不是工作表标签名

perfect131

shenzhenyang 发表于 2021-5-12 20:52
还需要指定工作的单元格内容命名工作薄。把这句 fileSaveName = Application.GetSaveAsFilename(Sheet12. ...

木有用过这一句Application.GetSaveAsFilename，改了一下，试试看
Sub kong()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim shp As Shape
    Dim wk As Workbook
    Set wk = ThisWorkbook
    Dim arr(1 To 10)
    Dim i
    Dim j
    i = 1
    j = 1
    Do While i < wk.Worksheets.Count + 1
        Set sh2 = wk.Worksheets(i)
        If sh2.CodeName = "Sheet12" Or sh2.CodeName = "Sheet13" Or sh2.CodeName = "Sheet14" Then
            If sh2.CodeName = "Sheet12" Then
                Dim fileSaveName
                fileSaveName = sh2.Range("$j1") & ".xlsx"
                If sh2.Range("$j1") = False Then
                    MsgBox "文件名空白！"
                    Exit Sub
                End If
            End If
            arr(j) = sh2.Name
            j = j + 1
        End If
        i = i + 1
    Loop
    wk.Sheets(Array(arr(1), arr(2), arr(3))).Copy
    For Each sht In wk.Worksheets
        With sht.UsedRange
            .Value = .Value
        End With
        For Each shp In sht.Shapes
            shp.Delete
        Next
    Next
    '另存位置在 当前工作簿文件夹，自行更改
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "/" & fileSaveName, FileFormat:=51
    ActiveWorkbook.Close , True
    Application.ScreenUpdating = True
    MsgBox "呵呵！另保存成功！"
End Sub

shenzhenyang

perfect131 发表于 2021-5-12 21:28
木有用过这一句Application.GetSaveAsFilename，改了一下，试试看
Sub kong()
    On Error Resume  ...

复制代码到我的表上一直提示名字空白，看不出哪里错误，帮我看下，谢谢

perfect131

shenzhenyang 发表于 2021-5-12 22:20
复制代码到我的表上一直提示名字空白，看不出哪里错误，帮我看下，谢谢

有密码啊这

shenzhenyang

perfect131 发表于 2021-5-12 22:26
有密码啊这

附件我重传，重新下载下

shenzhenyang

perfect131 发表于 2021-5-12 22:26
有密码啊这

重传附件            

shenzhenyang

perfect131 发表于 2021-5-12 22:26
有密码啊这

导出的表，不保留公式和控件

perfect131

你把值写在 j1,找了好久才发现
改了一下，j2 填好，试试看

perfect131

shenzhenyang 发表于 2021-5-12 22:32
导出的表，不保留公式和控件

哈哈，原来你把值写在了 j1,
把所有 ThisWorkbook 换为 Excel.ThisWorkbook
把 For Each sht In wk.Worksheets 换为 For Each sht In ActiveWorkbook.Worksheets
试试看