1

Excel 2007 を使用しています。表示されているすべてのシートを新しいワークブックにコピーし、テキスト ファイルとして保存するマクロを使用しています。12 枚以上のシートがあり、そこから少なくとも 10 枚のシートをコピーする必要があります。表示されている 4 枚のシートはコピーですが、5 枚目のシートで Application_defined または Object_defined エラーのエラーが発生しました。他に6枚の表があります。この問題を解決するのを手伝ってください。 

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
4

1 に答える 1

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
于 2012-10-16T18:54:57.813 に答える