[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数シートを複数ブックに保存』（みず）
お世話になります。
ブック内に複数のシートがあり
それぞれのシートを
それぞれ別ブックに保存したいのです。
細かく言うと
シート名
・一覧
・A
・B
・C
と4つのシートがあるとします。
ブックは3つに分ける。
シートの組み合わせは
1，一覧 ＆ A
2，一覧 ＆ B
3，一覧 ＆ C の
3つのブックを作りたいのです。
ネットから引用した
Sub TEST2()
Dim A
'シートをすべてループ
For Each A In Worksheets
'新規ブックにコピー
A.Copy
'名前を付けて保存
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & A.Name & ".xlsx"
ActiveWorkbook.Close False 'ブックを閉じる
Next
End Sub
を元に
Array("一覧",a).Copy としてみたり
使い方を分かっていないので上手くいきません。
For Each ＿＿ In Worksheets
以外の方法でないと
解決策ないのでしょうか？
どなたかご教授よろしくお願い致します。
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
＞Array("一覧",a).Copy としてみたり
＞使い方を分かっていないので上手くいきません。
それは、困りましたね。 ↓このへんを閲覧すると良いかもですね。 完全に理解するまで行かないでも良いので、なんとなくサラッとわかれば良 いかと思います。
シートを別ブックとして保存する http://officetanaka.net/excel/vba/tips/tips170.htm Office TANAKA 田中 亮
読んだら…まずは、下記( Sample1 )を実行してみましょう。
Sub Sample1()
Sheets(Array("一覧", "A")).Copy
End Sub
どうなりましたか？…できましたね。 一覧シートと、AシートのみをコピーしたBOOKが^^
でも、これだと手動でBOOK名を変更したり、大量に BOOKを作るとなるとやってられないです。(笑)
では、元BOOKを、Master.xlsm とした場合 その分身( 3つに分けるブック )複数BOOKを作成するとなると、その保存先は どうなるでしょうか？
当然、…Master( BOOK )と同じフォルダー内に収納したくなりませんか？ では、フォルダー内に、元BOOK( Master.xlsm )を入れて下記の( Sample2 )を 実行するとどうなりますでしょうか？
Sub Sample2()
Dim NewBookName As Variant
Dim i As Long
NewBookName = Array("A", "B", "C")
For i = 0 To UBound(NewBookName)
Select Case i
Case 0
ThisWorkbook.Worksheets(Array("一覧", "A")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path _
& "\一覧" & "&" & NewBookName(i) & ".xlsx"
ActiveWorkbook.Close False
Case 1
ThisWorkbook.Worksheets(Array("一覧", "B")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path _
& "\一覧" & "&" & NewBookName(i) & ".xlsx"
ActiveWorkbook.Close False
Case 2
ThisWorkbook.Worksheets(Array("一覧", "C")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path _
& "\一覧" & "&" & NewBookName(i) & ".xlsx"
ActiveWorkbook.Close False
End Select
Next
End Sub
意味合いは上記なんだけども…ちょっとコード長いから...変更^^;
Sub Sample3()
Dim SheetName As Variant
Dim i As Long
SheetName = Array("A", "B", "C")
For i = 0 To UBound(SheetName)
ThisWorkbook.Worksheets(Array("一覧", SheetName(i))).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path _
& "\一覧" & "&" & SheetName(i) & ".xlsx"
ActiveWorkbook.Close False
Next
End Sub
※やりたいことと違った場合は、他の回答者をお待ちください。
（あみな） 2022/06/04(土) 07:08
Sub test04()
Dim ws As Worksheet
Dim sPath As String
Dim sName As String
Const sKey As String = "XXXX"
Const sKey2 As String = "一覧"
sPath = ThisWorkbook.Path & "\" & sKey & ".xlsx"
For Each ws In ThisWorkbook.Worksheets
sName = ws.Name
If sName <> sKey2 Then
Worksheets(Array(sKey2, sName)).Copy
Workbooks(Workbooks.Count).Close SaveChanges:=True, Filename:=Replace(sPath, sKey, sName)
End If
Next
End Sub
（まっつわん） 2022/06/04(土) 09:03
■１
＞Array("一覧",a).Copy としてみたり
発想というか着眼点はわるくないです。
一覧シートとAシートを新規ブックにコピーする操作を【マクロの記録】でコード化してみるとおそらく↓のようなコードが記録されるかとおもいます。
Sheets(Array("一覧", "A")).Copy
これは
Sheets ( Array("一覧", "A") ) .Copy
シートの集まり のなかから 「一覧」と「A」という名前のシート を コピーしなさい 新規ブックへ
という意味になります。
つまり、「Array("一覧",a).Copy」がなぜ失敗したかというと【シートの集まり】というのを指定しなかったためです。
■２
＞For Each ＿＿ In Worksheets 以外の方法でないと解決策ないのでしょうか？
いえ、そんなことはないです。
既にあみなさんからも提示がありますが、組み合わせごとに【新規ブックへコピー】＆【新規ブックを名前を付けて保存してから閉じる】というのを３回やればよいです。
たとえば、こんな感じです。
Sub 研究用01()
ThisWorkbook.Worksheets(Array("一覧", "A")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\A"
ActiveWorkbook.Close False
ThisWorkbook.Worksheets(Array("一覧", "B")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\B"
ActiveWorkbook.Close False
ThisWorkbook.Worksheets(Array("一覧", "C")).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\C"
ActiveWorkbook.Close False
End Sub
■３
上記をみればわかるとおもいますが、一覧シートの相方になる【シート名】（と保存するときの名前）だけが変わってますよね。
ということは、シート名を入れ替えながら繰り返し処理をすれば、３回分をいちいち書かなくても済みそうですね。
たとえば、こんな感じです。
Sub 研究用02()
Dim シート名 As Variant
For Each シート名 In Array("A", "B", "C")
ThisWorkbook.Worksheets(Array("一覧", シート名)).Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & シート名
ActiveWorkbook.Close False
Next
End Sub
■４
「For Each ＿＿ In Worksheets」と表現された命令は、「For Each 〜 Nextステートメント」と呼ばれるものですが、集まりの中から1つずつ取り出して繰り返し処理を行うものです。
しがたって"In Worksheets"としているから、シートの集まりである（自ブックの）シートコレクションから１シートずつ取り出して処理していたわけです。
このように、集まりから１つずつ取り出しながら繰り返す命令ですから、使えるのはWorksheetsコレクションに限った話ではありません。ブックの集まりやセルの集まりなんかも対象ですし、データの集まりである【配列】も対象になります。
なので、「■3」では、"A", "B", "C"という文字列の集まりを作っておき、そこから1つずつ取り出させているわけです。
ただ、1点注意が必要なのが、For Each 〜 Nextステートメントに【配列】から取り出す場合、受け手はVariant型である必要があります。
"文字列"の集まりなんだからString型じゃないの？とおもうかもしれませんが、そういう仕様ですから我慢してください。
↓のようにしていたのは、そういう理由があってのことです。
Dim シート名 As Variant
（もこな２） 2022/06/04(土) 10:31
＞For Each 〜 Nextステートメント」・・・集まりの中から1つずつ取り出して繰り返し処理を行う
集まりの定義がわかっていませんでした。
＞For Each シート名 In Array("A", "B", "C")
("A", "B", "C")の部分のシート名は、特定でなく名前が変わって増えたりしますので
For Each 対象シート In Worksheets
Sheets(Array("一覧", シート名)).Copy を使わせて貰いました。
この時なかなかうまく動かなくて
色々悩んで
＞シートの集まり
という点をもう一度よく考え、シート名として認識させるにはと色々試して
Sheets(Array("一覧", シート名.Name)).Copyにたどり着きました。
まだ未完成なのでプログラムの続きを作って頑張って完成させます。
＞For Each 〜 Nextステートメントに【配列】から取り出す場合、受け手はVariant型である必要があります。
別シートのリストを【配列】と使いたいと考えていますので
注意点を覚えて置きます。
勉強になりました。
ありがとうございました。
（みず） 2022/06/05(日) 23:52
そういうことなら、完成形は↓のような感じになるとおもいます。
※「一覧」シート以外を「一覧」シートと組み合わせてコピーしたあと、組み合わせたシート名で保存
Sub 研究用03()
Dim SH As Worksheet
For Each SH In ThisWorkbook.Worksheets
If SH.Name <> "一覧" Then
ThisWorkbook.Worksheets(Array("一覧", SH.Name)).Copy
With Workbooks(Workbooks.Count)
.SaveAs Filename:=ThisWorkbook.Path & "\" & SH.Name
.Close False
End With
End If
Next
End Sub
（もこな２ ） 2022/06/06(月) 19:05
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.