VBA マクロ実行時エラー’1004RangeクラスのPasteSpecialメソッドが失敗

マクロ実行時に、エラー’1004RangeクラスのPasteSpecialメソッドが失敗と表記され、マクロが実行されません。

マクロの内容は、任意の範囲をコピー、新規book追加し、
新規bookに(1)Paste:=xlPasteValues　(2)Paste:=xlPasteColumnWidths　(3)Paste:=xlPasteFormats　の順に貼り付けし保存するものです。

いろいろ調べては見たのですが、当方初心者の為、わからずじまいです。お手数ではございますが、どなたかご教授願います。
下記にマクロ内容全部記載します。
よろしくお願いします。

*********************************************************
*********************************************************
Sub 日報別ファイルに保存したい1()
Worksheets("日報").Range("A3:AF36").Copy
With Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

ApplicationDisplayAlerts = True '同名FILEが存在する場合'
ActiveWorkbook.SaveAs Filename:= _
"c:\日報\" & ActiveSheet.Range("J2") & "年" & ActiveSheet.Range("l2") & "月" & ActiveSheet.Range("n2") & "日_日報.xls" _
, FileFormat:=xlNormal
.Close file


End With

End Sub

No.1 回答者： Wendy02 回答日時： 2009/08/24 19:31

こんばんは。

何が原因かは分かりません。
Excelのバージョンはいくつでしょうか。

最初、シートモジュールに書いたものだと思いましたが、どうもそうではないようです。

当面、このように考えてみました。

'-------------------------------------------
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'-------------------------------------------

xlPasteColumnWidths　

ステップ・マクロを動かしてみて、「xlPasteColumnWidths」マウスをここにおいてみてください。
「8」という数字が出てきていますか？定数が取れていない可能性があります。

もしそうなら、

Selection.PasteSpecial Paste:= 8, Operation:=xlNone, _

と入れてみてください。

この回答への補足

Wendy02さん、御回答ありがとうございます。
Excelのバージョンは2003です。
マクロ自体は標準モジュールに記載しております。

いろいろ情報が不足してしまい申し訳ありません。
さらに補足させていただきます。

コピー、新規book追加、cells.selectまでは実行されており、
一つ目のPaste部分でエラーとなります。
また、他のマクロが影響しているのではと思い、いろいろいじってみた
結果、「ThisWorkbook」上の下記のマクロを削除すると、正常に動きだしました。
****************************************************************
****************************************************************
Private Sub Workbook_Open()
If ActiveSheet.Name = "1" Then _
Application.Calculation = xlCalculationManual
End Sub
---------------------------------------------------------------
Private Sub Workbook_Activate()
If ActiveSheet.Name = "1" Or ActiveSheet.Name = "日報" Or
ActiveSheet.Name = "2" Or ActiveSheet.Name = "3" Or ActiveSheet.Name = "4" Or ActiveSheet.Name = "5" Or
ActiveSheet.Name = "6" Or ActiveSheet.Name = "7" Or ActiveSheet.Name = "8" Or ActiveSheet.Name = "9" Or
ActiveSheet.Name = "10" Or ActiveSheet.Name = "11" Or ActiveSheet.Name = "12" Or ActiveSheet.Name = "13" Or
ActiveSheet.Name = "14" Or ActiveSheet.Name = "15" Or ActiveSheet.Name = "16" Or ActiveSheet.Name = "17" Or
ActiveSheet.Name = "18" Or ActiveSheet.Name = "19" Or ActiveSheet.Name = "20" Or ActiveSheet.Name = "21" Or
ActiveSheet.Name = "22" Or ActiveSheet.Name = "23" Or ActiveSheet.Name = "24" Or ActiveSheet.Name = "25" Or
ActiveSheet.Name = "26" Or ActiveSheet.Name = "27" Or ActiveSheet.Name = "28" Or ActiveSheet.Name = "29" Or
ActiveSheet.Name = "30" Then _
Application.Calculation = xlCalculationManual
End Sub
---------------------------------------------------------------
Private Sub Workbook_Deactivate()
Application.Calculation = xlCalculationAutomatic
End Sub
---------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.Calculation = xlCalculationAutomatic
End Sub
****************************************************************
****************************************************************
マクロ内容は自動計算の設定です。
何か関係はあると思うのですが・・・。

補足日時：2009/08/25 10:39

No.2 ベストアンサー 回答者： Wendy02 回答日時： 2009/08/25 12:38

こんにちは。

>結果、「ThisWorkbook」上の下記のマクロを削除すると、正常に動きだしました。
それは、Copy 範囲が、消えてしまうことで、PasteSpecial が利かなくなってしまうからです。

まず、シート名の長いコードは、これだけでよいはずです。

Private Sub Workbook_Activate()
　Select Case StrConv(Trim(ActiveSheet.Name), vbNarrow)
　Case "1" To "30", "日報"
　 Application.Calculation = xlCalculationManual
　End Select
End Sub


-------------------------------------------
''もし、そのままでダメでしたら、　' Application.EnableEvents = False　'イベントの介入を阻止する　のところのコメント・ブロック（'コードの手前のアポストロフィ)を外して、再度試してみてください。

Sub 日報別ファイルに保存したい2()
Dim myRng As Range
Set myRng = Worksheets("日報").Range("A3:AF36")
　' Application.EnableEvents = False　'イベントの介入を阻止する

With Workbooks.Add
　 myRng.Copy
　.ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, _
　　　　　　　　　　　　　Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　 myRng.Copy
　.ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, _
　　　　　　　　　　　　　Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　 myRng.Copy
　.ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteFormats, _
　　　　　　　　　　　　　Operation:=xlNone, SkipBlanks:=False, Transpose:=False
　
　 Application.CutCopyMode = False
　
　ApplicationDisplayAlerts = True '**これは、そのままでは必要ないはずです。'
　
　ActiveWorkbook.SaveAs Filename:="c:\日報\" & ActiveSheet.Range("J2") & "年" & _
　　　　　　　　　　　　　　　　　ActiveSheet.Range("l2") & "月" & _
　　　　　　　　　　　　　　　　　ActiveSheet.Range("n2") & "日_日報.xls", _
　　　　　　　　　　　　　　　　　FileFormat:=xlNormal
　.Close file
End With
Set myRng = Nothing
'Application.EnableEvents = True　'イベントマクロの活動を戻す

End Sub

この回答へのお礼

Wendy02さん！ありがとうございます！
Wendy02さんに教えていただいたマクロで、正常に動きました！
本当に助かりました！

VBAの難しさも再認識です・・・。

初心者の私みたいなもんにご丁寧に対応いただき本当にありがとうございました。
また、何かあったときには、投稿させていただきたいと思います。
もちろん、自分なりに調べた上で・・・。

ありがとうございました。

お礼日時：2009/08/26 11:10