ブック内のシートを別ブックとして保存する用のマクロを作成しました！
梅屋
手動で「シートコピー＆保存」を永遠と
繰り返したら気が狂いそうになったので
VBA化しちゃいました！
どこに需要があるのかわかりませんが、コピペで使えるので興味がある方は使ってやって下さい…(汗)
もしかしたら事務職で役立てるかもしれません…。
目次
関連記事はこちら
あわせて読みたい
【初心者向け】公開されているVBAをコピペして動かす方法
梅屋 Web上で公開されているVBAを使ってみたいけど、どう使ったら良いのかわからない…。 今回はそんな人向けにコピペでVBAを動かす方法を紹介します。 ポイント VBAの動...
あわせて読みたい
【初心者向け】作成したVBAをボタンで実行する方法
前回はマクロをコピペして動かす方法を解説しましたが、今回は「ボタン」を押してマクロを実行する方法を解説していきます。 https://umeyalabo.com/vba-copy-paste VBA...
あわせて読みたい
ツールの流れ
１、ツールを実行
２、分割するブックを指定
３、保存先のフォルダの名前を入力
※入力後にフォルダが自動生成されます。
４、デスクトップに指定したフォルダが生成され、フォルダ内に分割したブックが出力されます。
※シート名＝ブック名になります。
ソースはこちら
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 |
Sub sheets_split() Application.ScreenUpdating = False Application.DisplayAlerts = False MsgBox "分割するブックを指定してください。", vbInformation Dim path As String, WSH As Variant, OpenFileName As String, fname As String Set WSH = CreateObject("WScript.Shell") path = WSH.SpecialFolders("Desktop") & "\" ChDir path fname = Application.GetOpenFilename If fname <> "False" Then Workbooks.Open Filename:=fname Else MsgBox "キャンセルされました。もう一度分割するブックを指定してください。", vbInformation Exit Sub End If '保存先を確認 Dim ans As String label1: ans = InputBox("保存するフォルダ名を入力してください。(自動生成)", "保存先指定", "") 'デスクトップに指定したフォルダがなければ作成 If ans <> "" Then If Dir(path & ans, vbDirectory) = "" Then MkDir path & "\" & ans Else MsgBox "フォルダ名が重複しています。別の名前を設定してください。", vbInformation GoTo label1 End If Else Dim rc As VbMsgBoxResult rc = MsgBox("キャンセルしました。ファイル分割を続けますか？", vbYesNo) If rc = vbNo Then ActiveWorkbook.Close MsgBox "分割を中止します。", vbInformation Exit Sub Else GoTo label1 End If End If Dim sh As Worksheet For Each sh In Worksheets sh.Copy ActiveWorkbook.SaveAs path & ans & "\" & sh.Name ActiveWorkbook.Close Next sh ActiveWorkbook.Close MsgBox "終了しました！", vbInformation Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub |