色の知識で人生の可能性が広がる!みんなに役立つ色彩検定 >>

下記のエラーが出ます、似たようなもので新規ファイルで保存できたのですが
今回は出来ない状態になってしまいました。
ちょこちょこマクロ使うのですが、初心者で解決できません。
マクロ先生のご指導をお願いします。
※コピーされたシートが新ファイルで開かれた状態でエラー表示となります。


「実行時エラー '1004':

'SaveAs' メソッドは失敗しました: '_Worksheet' オブジェクト」


'指定額の抽出
Private Const MESSAGE_FINISH = "予算出力処理が完了しました"

Sub 予算データテキスト出力()
Dim ws1
Set ws1 = Worksheets("チェック一覧")
Dim m As Long
m = 3
Dim ws2
Set ws2 = Worksheets("予算データ")

Dim sm As String

Dim ws3

Dim sn

'チェック一覧シートのNo.が無くなるまで処理する
Do Until ws1.Cells(m, 1) = ""

Application.ScreenUpdating = False


If ws1.Cells(m, 4) = "" Then
'ナンバーがある場合は部門等をチェック一覧(ws1)→フォーム(ws2)に転記する
Else
ws2.Cells(2, 2) = ws1.Cells(m, 4)

'各部署のシート名をsmにセットする
sm = ws1.Cells(m, 2)
Set ws3 = Worksheets(sm)

'予算フォーム(ws2)の行変数「s」と各部署シート(ws3)の行変数「n」
Dim s
s = 4
Dim n
n = 9
Dim cnt
cnt = 1

Do Until n = 44
If ws3.Cells(n, 23) = 0 Then

'各数値等を各部署のシート(ws3)→フォーム(ws2)に転記する
Else

ws2.Cells(s, 1) = cnt
ws2.Cells(s, 3) = 6100
ws2.Cells(s, 4) = 0
ws2.Cells(s, 5) = ws3.Cells(3, 4)
ws2.Cells(s, 6) = ws3.Cells(5, 8)

ws2.Cells(s, 7) = ws3.Cells(n, 4)
ws2.Cells(s, 8) = ws3.Cells(n, 24)
ws2.Cells(s, 9) = ws3.Cells(n, 25)
ws2.Cells(s, 10) = ws3.Cells(n, 26)
ws2.Cells(s, 11) = ws3.Cells(n, 27)
ws2.Cells(s, 12) = ws3.Cells(n, 28)
ws2.Cells(s, 13) = ws3.Cells(n, 29)
ws2.Cells(s, 14) = ws3.Cells(n, 31)
ws2.Cells(s, 15) = ws3.Cells(n, 32)
ws2.Cells(s, 16) = ws3.Cells(n, 33)
ws2.Cells(s, 17) = ws3.Cells(n, 34)
ws2.Cells(s, 18) = ws3.Cells(n, 35)
ws2.Cells(s, 19) = ws3.Cells(n, 36)
s = s + 1
cnt = cnt + 1

End If

n = n + 1

Loop
'予算データに転記されたので出力する

ws2.Copy

' ↓↓↓↓↓この下の「SaveAs」がエラーになります。↓↓↓↓↓

ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText

ActiveWindow.Close

ActiveWorkbook.Close savechanges:=False


'フォームに転記した情報をクリア
ws2.Select
Range(Cells(4, 1), Cells(44, 19)).Select
Selection.ClearContents


End If

m = m + 1


Loop

ws1.Select

MsgBox MESSAGE_FINISH

End Sub

教えて!goo グレード

A 回答 (2件)

No1の方が指摘されているように、


ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText
のときの、 ws2.Cells(s, 5).Valueの値が不正な可能性があります。

この行の直前で、
msgbox("<" & ws2.Cells(s, 5).Value & ">")
を行い、ws2.Cells(s, 5).Valueの内容を確認しては、いかがでしょうか。
    • good
    • 1
この回答へのお礼

ありがとうございます
ご指摘の通りmsgboxで中身を見たら「空っぽ」でした
なので下記のように変更したらエラーでなくなりました
こういうデバッグというかエラーつぶしの作業経験が少なく
msgboxを使うデバッグを思い出し、重要性に気づきました。
ありがとうございました。

<<変更後>>
ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws3.Cells(4, 8).Value & ".txt", FileFormat:=xlText

お礼日時:2017/03/16 09:39

ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & _


ws2.Cells(s, 5).Value & ".txt", FileFormat:=xlText

ActiveWorkbook とは、ここでは、ws2.Copy で切り離されたシートのことだと思います。ファイル名として、ws2.Cells(s, 5).Value を一旦、変数に置き換えずに、そのまま、保存に使うのはちょっと無謀かなって思います。

s は、カウンター変数で、ループの最後、 s = s + 1 となって、どこでもない所かもしれません。定数なりで決める必要があります。

一度、ws2.Cells(s, 5).Value  の中身を確認すべきでしょうね。
そして、ファイル名の付け方には、もう少し工夫が必要だと思います。
    • good
    • 0
この回答へのお礼

ありがとうございます
ご指摘の通り、無謀だったようです

別マクロで似たような感じで保存名で使った事があり
安心しきっていましたが、ws2の状態では空データの
ようで、それが原因でエラーになっていたようです。
変数にはしなかったのですがws3の情報を指定して
保存することが出来ました。
ありがとうございました。

<<変更後>>
ActiveWorkbook.SaveAs Filename:="D:\Library\Desktop\新しいフォルダー\" & ws3.Cells(4, 8).Value & ".txt", FileFormat:=xlText

お礼日時:2017/03/16 09:36

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング