外出自粛中でも楽しく過ごす!QAまとめ>>

シート毎に別々のファイルに保存するためのVBAを作成しております。
現在のコードは以下の通りです。

'シート名をそのままファイル名にする方法

Dim i As Integer
Dim wb1 As Workbook
Dim SheetCnt As Integer

Set wb1 = ActiveWorkbook
SheetCnt = wb1.Sheets.Count

For i = 1 To SheetCnt
If Sheets(i).Visible = True Then
ChDir CreateObject("WScript.Shell").SpecialFolders("desktop") & "\"
Workbooks.Add.SaveAs Filename:="分析_" & Worksheets(i).Name & ".xlsx"
wb1.Worksheets(i).Copy Before:=Workbooks("分析_" & Worksheets(i).Name & ".xlsx").Worksheets(1)  ・・・①
'シートを保存して閉じる
ActiveWorkbook.Close SaveChanges:=True
End If

マクロを実行すると新しいworkbook作成迄は実行されますが、その後のコピペ(①の箇所)でエラーとなります。
どの様に変更すれば良いか教えて頂けないでしょうか。
併せて「シートを保存して閉じる」際に「リンクの自動更新を無効」にしたまま保存する様にしたいと考えています。

良いお知恵をお貸しください。
宜しくお願いします。

A 回答 (4件)

こんにちは



少し整理してみました。

>「リンクの自動更新を無効」にしたまま
もとのブックにリンクが存在するということでしょうか?
個々に処理をするのが面倒だったので、まとめて「値をペースト」形式にしてしまっています。
(ですので、シート内リンクや関数式も値に変換されちゃいます)

きちんと「リンクの自動更新を無効」をなさりたい場合は、BreakLinkで処理してください。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

※ 既存のファイル名をチェックしていませんので、同名のファイルが存在する場合には上書きの確認メッセージが表示されます。
※ シート数が多く画面がチラつくような場合は、ScreenUpdatingをFalseにするとよいでしょう。

Sub Sample_11700270()
Dim sPath As String, sh As Worksheet
sPath = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\分析_"

For Each sh In Worksheets
 sh.Copy
 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
 ActiveWorkbook.SaveAs Filename:=sPath & sh.Name & ".xlsx"
 ActiveWorkbook.Close SaveChanges:=False
Next sh
End Sub
    • good
    • 0
この回答へのお礼

fujillinさん
いつも有難うございます。

私の質問の仕方が拙かったですね。

今開いているブックに4つのシートがあり、それぞれのシートを新たなにデスクトップに作成したフォルダに
コーピーしてシート名で保存する
と言う作業を行っております。

今の総てのコードは
Dim fso As Object
Dim FolPath As String
FolPath = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\あ"
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(FolPath) Then
fso.DeleteFolder FolPath
fso.CreateFolder (FolPath)
Else
fso.CreateFolder (FolPath)
End If

Dim i As Integer
Dim wb1 As Workbook
Dim SheetCnt As Integer

Set wb1 = ActiveWorkbook
SheetCnt = wb1.Sheets.Count

For i = 1 To SheetCnt
If Sheets(i).Visible = True Then
ChDir CreateObject("WScript.Shell").SpecialFolders("desktop") & "\あ"
Workbooks.Add.SaveAs Filename:="い_" & Worksheets(i).Name & ".xlsx"
wb1.Worksheets(i).Copy After:=Workbooks("い_" & Worksheets(i).Name & ".xlsx").Worksheets(1)

ActiveWorkbook.Close SaveChanges:=True
End If

Next i

です。

先ほどご教授頂いたコードでは上手くいかなくて....

宜しくお願い致します。

お礼日時:2020/06/12 11:40

#3です。


#1の補足を見て
一応、不具合を避けるため、wb1. を あと2か所(全部で3か所)追記しブックを明示した方が良いと思います。
更に、デバックなどで再度実行時エラーを避けるために
Else
fso.CreateFolder (FolPath)
End If
Set fso = Nothing  '破棄しておいた方が良いと思います。

あと、ChDir FolPath で良いと思いますよ。同じなので、、
    • good
    • 0
この回答へのお礼

助かりました

Qchanさん

ご丁寧なご説明有難うございます。
大変助かります。

VBAは奥が深くて苦労します。

お礼日時:2020/06/12 19:49

こんばんは、


横から失礼します。リンクについては、すでに回答が出ておりますので、
エラー箇所へのアドバイスです。
SheetCnt = wb1.Sheets.Count コピー元のシート数
For i = 1 To SheetCnt コピー元のシート数分ループする

wb1.Worksheets(i).Copy Before:=Workbooks("分析_" & Worksheets(i).Name & ".xlsx").Worksheets(1)

1周目のForでは、i=1なので必ずありますが、2周目では、あるかどうかは、わかりません。
Excelのオプションで新規作成ブックのシート数が影響します。

この場合、Workbooks("分析_" & Worksheets(i).Name & ".xlsx")のシートを作成して行く方法か、コピーシートを
挿入して行く方法を取らないと 2周目 Worksheets(i).Namは、インデックス2となり、Workbooks.Addで作成したブックになければ
当然、エラーが返りますね。
しかし、シートを作って行きたい訳ではないでしょうから、、
多分、
Worksheets(i).Nameが元ブックのシート名を指すものと推測します。従って、
Workbooks("分析_" & wb1.Worksheets(i).Name & ".xlsx") とするようにします。

検証していませんので的違いなら、忘れてください。
    • good
    • 0
この回答へのお礼

ご回答有難うございます。
Qchan1962さんは、もともと私が記載したコードで回答頂いたんですね。
このコードでも一度試してみます。

有難うございました。

お礼日時:2020/06/12 18:42

No1です



>先ほどご教授頂いたコードでは上手くいかなくて....
何がうまくいかないのかが不明ですが、No1のコードではデスクトップ上に「分析_ & シート名」のファイル名で各シートが保存されるはずです。
そうなってはいないでしょうか?
(ご提示のコードの内容が、そのように読み取れましたので)

デスクトップ上の「あ」フォルダに保存したければ、
sPath = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\分析_"

sPath = CreateObject("WScript.Shell").SpecialFolders("desktop") & "\あ\い_"
に変えればすむだけのことと思いますけれど・・・?

※ No1にも記しましたように、フォルダの存在チェックや作成、ファイルの既存在チェックなどは行っていませんので必要に応じて追加してください。
    • good
    • 0
この回答へのお礼

fujillinさん

ご指示頂いたように変更しましたら解決しました。
有難うございました。

お礼日時:2020/06/12 18:42

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

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


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

人気Q&Aランキング