質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

1回答

33222閲覧

saveas メソッドは失敗しました workbookオブジェクト

yumeno

総合スコア27

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

1クリップ

投稿2019/02/19 08:30

前提・実現したいこと

はじめまして、エラーの避け方について教えてください

現在リストのIDごとに別ブックを作るVBAを作成しています。
IDがひとつの場合はうまくいきますが、2つ以上だと同じ場所でエラーが出てしまいます。

調べたところいくつか解決法がありましたが、どれもうまくいきません。

発生している問題・エラーメッセージ

saveas メソッドは失敗しました workbookオブジェクト

該当のソースコード

Sub Sample()

Dim MacroB As Worksheet 'このブックのシート Dim Wb_Data As Workbook '1. 分割元ブック Dim Wb_new As Workbook '分割データ保存ブック Dim Ws As String '2. 分割元シート名 Dim Path As String '3. 分割データ保存先 Dim C_Group As String '4. グループ対象列 Dim C_Copy As String '5. コピーデータ右端列 Dim R_Data As Integer 'データの行番号 Dim Ko As Integer 'グループの件数 Set MacroB = Workbooks("作成マクロ.xlsm").Worksheets(1) 'このブックのシート Set Wb_Data = Workbooks(MacroB.Range("C11").Value) '分割元のブック名 Ws = MacroB.Range("C12") Path = MacroB.Range("C13") & "\" C_Group = MacroB.Range("C14") C_Copy = MacroB.Range("C15") R_Data = 2 'データの開始行 Application.ScreenUpdating = False Do Wb_Data.Activate Worksheets(Ws).Range(Cells(1, 1), Cells(1, C_Copy)).Copy '1行目の項目名コピー Workbooks.Add ActiveSheet.Paste Range("A1") '新規ブックに貼り付け Set Wb_new = ActiveWorkbook Wb_Data.Activate Ko = WorksheetFunction.CountIf(Columns(C_Group), Cells(R_Data, C_Group)) 'グループの件数を算出 Range(Cells(R_Data, "A"), Cells(R_Data + Ko - 1, C_Copy)).Copy 'グループ件数分コピー Wb_new.Activate ActiveSheet.Paste Range("A2") '新規ブック項目の下に貼り付け

__ Wb_new.SaveAs Filename:=Path & Cells(2, C_Group) & "_" & Cells(2, 2) & ".xlsx", FileFormat:=1__
↑ここで『saveas メソッドは失敗しました workbookオブジェクト』がでます

'指定したフォルダーに保存 Wb_new.Close R_Data = R_Data + Ko Loop While Cells(R_Data, C_Group) <> "" MsgBox "完了!" Application.ScreenUpdating = True

End Sub

試したこと

・, FileFormat:=1 の追加、削除を行いましたが
どうしても重複が複数あるときに同じことが起こります。

・エクセルの再起動
・変数宣言を強制するにチェック

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

imihito

2019/02/19 12:51

修正依頼:コードの前後に「```」を追加し、コードを見やすくしてください(コードを選択して<code>ボタンでも可) / 情報追記依頼:① SaveAs実行時に`Path & Cells(2, C_Group) & "_" & Cells(2, 2) & ".xlsx"`がどんな値になっているか。② 表の大まかな構成について。
guest

回答1

0

色々あるかと思いますが、重複を避けてナンバリングする方法はいかがでしょうか。
動かしてないのでエラーがあるかも(^^;
重複したときは保存したくなければ保存しなければOKです。
あと、重複したくないだけだったらファイル名に日時を入れるのも手です。保存時間(秒)がずれるはずなので。

VBA

1 Dim strFileName As String 2 Dim lngFIleNo As Long 3 lngFIleNo = 1 4 strFileName = Path & Cells(2, C_Group) & "_" & Cells(2, 2) 5 Do While True '保存するまで繰り返す 6 If Dir(strFileName & lngFIleNo & ".xlsx") = "" Then 'ファイルが既に存在しているか調べる 7 '無いのでそのまま保存 8 Wb_new.SaveAs Filename:=strFileName & lngFIleNo & ".xlsx", FileFormat:=1 9 Exit Do 10 Else 11 'あるので名前を変える 12 lngFIleNo = lngFIleNo + 1 13 '飛ばす場合は Exit Do 14 End If 15 Loop 16

投稿2019/02/20 06:48

SuperTarokun

総合スコア44

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問