Question

我正在使用excel 2007.我正在使用一个宏将所有可见的工作表复制到新工作簿并保存为文本文件。我有超过12张，我必须至少复印10张。 4个可见的工作表是副本，但在第五个工作表上，我收到了Application_defined或Object_defined错误的错误。我有六张桌子。请帮我解决这个问题。

Sub day_end_process()

'Working in 97-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim sh As Worksheet
Dim DateString As String
Dim FolderName As String

'Copy every sheet from the workbook with this macro
Set Sourcewb = ThisWorkbook

'Create new folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = Sourcewb.path & "\" & Sourcewb.Name & " " & DateString
MkDir FolderName

'Copy every visible sheet to a new workbook
For Each sh In Sourcewb.Worksheets

    'If the sheet is visible then copy it to a new workbook
    If sh.Visible = -1 Then
        sh.Copy

        'Set Destwb to the new workbook
        Set Destwb = ActiveWorkbook

        'Determine the Excel version and file extension/format
        With Destwb
            FileExtStr = ".txt": FileFormatNum = -4158
        End With

        'Change all cells in the worksheet to values if you want
        'I get error in this if statement.

        If Destwb.Sheets(1).ProtectContents = False Then
            With Destwb.Sheets(1).UsedRange
                .Cells.Copy
                .Cells.PasteSpecial xlPasteValues
                .Cells(1).Select
            End With
            Application.CutCopyMode = False
        End If
        'Save the new workbook and close it
        With Destwb
            .SaveAs FolderName _
                  & "\" & Destwb.Sheets(1).Name & FileExtStr, _
                    FileFormat:=FileFormatNum
            .Close False
        End With
    End If
GoToNextSheet:
Next sh
MsgBox "You can find the files in " & FolderName
Sheets("Main Page").Select
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
Sheets("Main Page").Select
ActiveWorkbook.Save

End Sub

Answer 1

取代

    If Destwb.Sheets(1).ProtectContents = False Then 
        With Destwb.Sheets(1).UsedRange 
            .Cells.Copy 
            .Cells.PasteSpecial xlPasteValues 
            .Cells(1).Select 
        End With 
        Application.CutCopyMode = False 
    End If

也许试试：

    If Destwb.Sheets(1).ProtectContents = False Then 
        Destwb.Sheets(1).UsedRange.value = Destwb.Sheets(1).UsedRange.value 
    End If

对象定义错误

1 个答案: