修改代码，谢谢

lengyifei

Private Sub CommandButton1_Click()
    Dim MyArr, MyPath As String, MyFullName As String
    MyArr = Sheet7.Range("A1").CurrentRegion
    If UBound(MyArr) < 2 Then Exit Sub

    Application.ScreenUpdating = False
    MyPath = ThisWorkbook.Path
    For i = 2 To UBound(MyArr)
        If Len(MyArr(i, 2)) > 0 Then
            MyFullName = MyPath & "\" & MyArr(i, 1) & ".xlsx"
            Sheets(MyArr(i, 1)).Copy
            ActiveWorkbook.SaveAs Filename:=MyFullName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWorkbook.Close
        End If
    Next i
    Application.ScreenUpdating = True
End Sub


这段代码可以导出单个的工作表，现在想改成导出一个工作簿，并且去掉公式，改了几次老出错，麻烦各位大神给修改下，谢谢

3190496160

上传附件，具体描述需求，看你目前的代码，没法了解你真正的需求

wanao2008

导出工作簿可以用另存为的方法。
即，去掉【Sheets(MyArr(i, 1)).Copy】这句试试。

fzxba

zjzyj

Sheets(MyArr(i, 1)).Copy
改为
Sheets.Copy

lengyifei

多谢各位，我另外开个求助，上传附件，谢谢谢谢

lengyifei

fzxba 发表于 2023-3-27 17:56

next i  提示错误

with.worksheets(i).usedrange    提示下标越界，什么原因？


多谢