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

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

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

CSV(Comma-Separated Values)はコンマで区切られた明白なテキスト値のリストです。もしくは、そのフォーマットでひとつ以上のリストを含むファイルを指します。

ファイル

ファイルとは、文字列に基づいた名前又はパスからアクセスすることができる、任意の情報のブロック又は情報を格納するためのリソースです。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

2回答

1412閲覧

エクセルシートをそれぞれ保存するマクロを作成したい

退会済みユーザー

退会済みユーザー

総合スコア0

CSV

CSV(Comma-Separated Values)はコンマで区切られた明白なテキスト値のリストです。もしくは、そのフォーマットでひとつ以上のリストを含むファイルを指します。

ファイル

ファイルとは、文字列に基づいた名前又はパスからアクセスすることができる、任意の情報のブロック又は情報を格納するためのリソースです。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2021/05/14 01:45

前提・実現したいこと

エクセルに13個のシートがあります。

シート名は、以下の通りです。
表紙,1,2,3,4,5,6,7,8,9,10,11,12

1.表紙のセルA2に入力した文字をフォルダ名にしてデスクトップに保存
2.シート1~12のシートをそれぞれCSVファイルにして1のフォルダに保存

というマクロを組みたいですが、うまくいきません。
試したことへ作成したマクロを貼り付けました。

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

エラーメッセージ

該当のソースコード

ソースコード

試したこと

Sub 切り分け()

ActiveWindow.WindowState = xlMinimized

Dim path As String
Dim WSH As Object
Dim OpenFileName As String
Dim FolderName As String

'作成するフォルダ名
FolderName = Range("A2").Value

'特殊フォルダの取得
Set WSH = CreateObject("WScript.Shell")

'デスクトップの位置を取得
path = WSH.SpecialFolders("Desktop") & ""

'カレントフォルダ変更
ChDir path

'デスクトップに指定したフォルダがない場合作成する
If Dir(path & FolderName, vbDirectory) = "" Then

MkDir path & "\" & FolderName Application.ScreenUpdating = False

End If

Sheets("7").Select Sheets("7").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\7.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("8").Select Sheets("8").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\8.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("9").Select Sheets("9").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\9.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("10").Select Sheets("10").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\10.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("11").Select Sheets("11").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\11.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("12").Select Sheets("12").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\12.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("1").Select Sheets("1").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\1.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("2").Select Sheets("2").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\2.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("3(うるう年調整必要)").Select Sheets("3(うるう年調整必要)").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\3.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("4").Select Sheets("4").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\4.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("5").Select Sheets("5").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\5.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("6").Select Sheets("6").Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ChDir "C:\Users\bd11\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\bd11\Desktop\6.csv", FileFormat:= _ xlCSV, CreateBackup:=False ActiveWindow.Close Sheets("スケジュール").Select

End Sub

補足情報(FW/ツールのバージョンなど)

ここにより詳細な情報を記載してください。

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

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

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

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

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

jinoji

2021/05/14 03:38

うまくいきません、というのをもう少し具体的に言うと、何がどうなるのですか?
guest

回答2

0

ベストアンサー

ExcelVBA

1Option Explicit 2 3Sub test() 4 Dim i As Long 5 Dim FolName As String 6 Dim ws As Worksheet 7 8 '保存先フォルダー名取得 9 FolName = GetFolderPath(ThisWorkbook.Worksheets("集計").Range("A2").Value) 10 11 For i = 1 To 12 12 Set ws = Nothing '変数の初期化 13 'シートの存在確認 14 On Error Resume Next 15 Set ws = ThisWorkbook.Worksheets(CStr(i)) 16 On Error GoTo 0 17 18 'シートがあったときの処理 19 If Not ws Is Nothing Then 20 ws.Copy 21 With Workbooks(Workbooks.Count) 22 .SaveAs FolName & "\" & ws.Name & ".csv", xlCSV 23 .Close False 24 End With 25 End If 26 Next 27End Sub 28 29'保存先フォルダーの取得関数(なければ新規作成) 30Function GetFolderPath(ByVal sName As String) As String 31 Dim myPath As String 32 33 myPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & sName 34 'フォルダーの存在確認 35 If Dir(myPath, vbDirectory) = "" Then 36 MkDir myPath 'なければ作る 37 End If 38 39 GetFolderPath = myPath 40End Function

1)同じようなことを繰り返すときは、For~Nextなどで繰り返したらいいです。
変数を上手く使って、変わらなければいけないところを変えられるように書けばよいです。

2)CSV形式のファイルは数式などの情報は含まれませんので、
敢えて明示的に値に変換しなくても保存するときに勝手に変換されます。

3)フォルダーやファイルやシート等、間違って削除することもあるので、
もう少し真面目に存在確認の結果でどうするか考えてみてもいいかもです。

※あくまでサンプルです。思いついたまま書いてテストしてないので、
バグがあればご容赦願います。自己責任で使用をお願いします。

投稿2021/05/15 00:17

mattuwan

総合スコア2136

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

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

退会済みユーザー

退会済みユーザー

2021/05/15 01:42

ありがとうございます! うまく動作しました。
guest

0

とりあえず。

VBA

1Dim ws As Worksheet 2Dim fn As String 3Dim wb As Workbook 4 5For Each ws In ThisWorkbook.Worksheets 6 If Not ws.Name = "表紙" Then 7 fn = path & FolderName & "\" & ws.Name & ".csv" 8 ws.Copy 9 Set wb = ActiveWorkbook 10 wb.Worksheets(1).UsedRange.Value = wb.Worksheets(1).UsedRange.Value 11 wb.SaveAs FileName:=fn, FileFormat:=xlCSV, CreateBackup:=False 12 wb.Close False 13 End If 14Next 15

投稿2021/05/14 03:50

jinoji

総合スコア4585

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

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

退会済みユーザー

退会済みユーザー

2021/05/14 03:57

ご回答ありがとうございます! 早速実行しましたところ、 wb.SaveAs Filename:=fn, FileFormat:=xlCSV, CreateBackup:=False の部分が読み取り専用の為デバックになりました。 改善策はありますか?
jinoji

2021/05/14 09:46

その箇所でエラーになる理由が思いつきません。 fnの値は意図通りに作られていますか?
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

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

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

質問する

関連した質問