[[20180511152458]]　『一部シートのみ実行したい。』（ゾーマ）　ページの最後に飛ぶ

『一部シートのみ実行したい。』（ゾーマ）

すべてのシートを分割してブックにするマクロを使っていたのですが、
全部が全部必要ではなく、不要なシートも分割されて手間が増えていたので
全シートに実行と、特定のシートに実行の分岐点をつくって見たのですが、
ユーザーフォームで必要なシートを選択してもらうところまでは思いつきましたが、
その後どうすればよいか考えが及ばず思いつきませんでした。

続きご指導いただければと思います。
なお、途中まで作ってしまったのですが、
ほかにもっと良い方法があれば変更も検討します。

以下コード。

基準モジュール？

Public 選択list As String
Sub シートを分割して保存()

 Dim MyName As String
 Dim rc As Integer

 With Application.FileDialog(msoFileDialogFolderPicker)
 .Title = "フォルダを選択して、ＯＫをクリック"
 If .Show = True Then
 folder = .SelectedItems(1)
 Else
 Exit Sub
 End If
 End With

 rc = MsgBox("全シート処理でよろしいですか？", vbYesNo + vbWuestion, "全シートか、一部シートか")
 If rc = vbYes Then

 MyName = InputBox("頭につけるブック名を入力してください", "ブック名入力")
 Application.ScreenUpdating = False
 For Each シート In Worksheets
 If シート.Name <> "macro" Then
シート.Copy
 ActiveWorkbook.SaveAs folder & "\" & MyName & シート.Name
 ActiveWorkbook.Close
 End If
 Next シート
 Application.ScreenUpdating = True
 MsgBox "終了しました！"

Else
UserForm1.Show

MsgBox (選択list)

’ここから思いつきません＞＜

Err_frmShow:
End If

End Sub

ユーザーフォーム
Private Sub UserForm_Initialize()
Dim i As Integer
ListBox1.MultiSelect = fmMultiSelectMulti

For i = 1 To Worksheets.Count

    ListBox1.AddItem (Worksheets(i).Name)
Next i

End Sub

Private Sub CommandButton1_Click()
Dim i As Integer

With ListBox1

    For i = 0 To .ListCount - 1
        If .Selected(i) = True Then
            選択list = 選択list & .list(i) & vbCrLf
        End If
    Next i
End With

MsgBox 選択list

Unload Me

End Sub

どうかお願いいたします！

＜使用 Excel：Excel2013、使用 OS：unknown ＞

 MsgBox (選択list)
'ここから思いつきません＞＜
 MyName = InputBox("頭につけるブック名を入力してください", "ブック名入力")
 Application.ScreenUpdating = False
 For Each シート In Split(選択list, vbCrLf)
    If シート <> "macro" Then
        Worksheets(シート).Copy
        ActiveWorkbook.SaveAs folder & "\" & MyName & シート
        ActiveWorkbook.Close
    End If
 Next シート
 Application.ScreenUpdating = True
 MsgBox "終了しました！"
Err_frmShow:
（mm） 2018/05/11(金) 15:58

mm様
ありがとうございます。
できたのですが、おそらく選択していないシートを処理してしまい、

Worksheets(シート).Copyで
実行時エラー９　インデックスが有効範囲にありません。

となり、エラーになってしまいます。
エラー無視で大丈夫だとは思いますが解決方法はありますか？
（ゾーマ） 2018/05/11(金) 16:13

    If シート <> "macro" and  Evaluate("isref('" & シート & "'!a1)") Then

（mm） 2018/05/11(金) 16:27

なるほど、Evaluateとisref関数をつかってそれが有るかどうかをみて
なければ飛ばしてるんですね。

ありがとうございます。
（ゾーマ） 2018/05/11(金) 16:37

思ったのですが
If Evaluate("isref(" & シート & "!a1)") = True Then
でも大丈夫ですよね？

（の後の’はなぜいるのでしょか。

（ゾーマ） 2018/05/11(金) 17:07

mm様のコードを実行してみましたが、型が違いますとなり。うまくいきませんでした・・・。
一応エラー無視で作動させた結果は
思った通りの動作になったのですが、プラスして
現在開いているブックもＭｙｎａｍｅで記述したもので別名保存されてしましました。

シートが存在しないかどうかを判別して有ればコピーしていると理解し、
いけるかと思ったのですがだめでした。

別の方法も含め、ご指導お願いいたします。
（ゾーマ） 2018/05/14(月) 11:27

悩んでるポイントがよくわからないですが、実際に処理するのは、ユーザーフォームのコマンドボタン押したときだから、そちらで処理するようにすればいいんじゃないですか？

■標準モジュールに記述

    Public MyPath As String

    Sub シートを分割して保存()
        Dim MyName As String

        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "フォルダを選択して、ＯＫをクリック"
            If .Show = True Then
                MyPath = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With

        MyName = InputBox("頭につけるブック名を入力してください", "ブック名入力")
        MyPath = MyPath & "\" & MyName

        UserForm1.Show

    End Sub

■UserForm1のモジュールに記述

    Private Sub UserForm_Initialize()
        Dim sh As Worksheet

        For Each sh In ThisWorkbook.Worksheets
            ListBox1.AddItem sh.Name
        Next sh
    End Sub

    Private Sub CommandButton1_Click()
        Dim i As Long, c As Long, tmp As String

        With ListBox1
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                    tmp = .List(i)
                    With Workbooks.Add
                        ThisWorkbook.Worksheets(tmp).Copy _
                            Before:=.Worksheets(1)

                        Application.DisplayAlerts = False
                        For c = 2 To .Worksheets.Count
                            .Worksheets(c).Delete
                        Next
                        Application.DisplayAlerts = True

                        .SaveAs Filename:=MyPath & "_" & tmp
                        .Close

                    End With
                End If
            Next i
        End With

        MsgBox "処理終了"
        Unload Me
    End Sub

ちなみに、どっちでもいいとおもいますけど、「ListBox1.MultiSelect」は、実行するごとに設定するんじゃなくて、ユーザーフォームの設計段階で設定しておいてもいいんじゃないでしょうか？

（もこな２） 2018/05/14(月) 14:31

返信遅れましてすみません。
もなこ２様の案を試したのですが、

 ThisWorkbook.Worksheets(tmp).Copy _
 Before:=.Worksheets(1)
実行時エラー'1004' 移動先またはコピー先のブックの行列数が元のブックの行列数よりも少ないため、シートを移動先またはコピー先のブックに挿入できません。データを別のブックに移動またはコピーするには、データを選択して、「コピー」コマンドと「貼り付け」コマンドを使用して移動先またはコピー先のブックにシートを挿入してください。

となります。
ちゃんと１０４８５７６行までありましたので古いエクセルを使っているわけでもなさそうなのですが
なんでこれが出るのか分かりますでしょうか。

＞ちなみに、どっちでもいいとおもいますけど、「ListBox1.MultiSelect」は、実行するごとに設定するんじゃなくて、ユーザーフォームの設計段階で設定しておいてもいいんじゃないでしょうか？

これはその通りプロパティで直しました！
（当時わからずググったら記述する方式が乗ってたため、そのまま採用してました。）
（ゾーマ） 2018/05/15(火) 19:15

思ったのですが、
addで新しくブックをつくったのでそれがアクティブになってしまい
ThisWorkbook.Worksheets(tmp)がなく、コピーできないということでしょうか。
（ゾーマ） 2018/05/15(火) 19:29

横入り失礼します。

なんで、ユーザーフォームをわざわざ使うのですか？
普通にシートタブを選択したらいいのでは？

選択したら、
選択したシートだけ作業をすればいいだけです。

参考URL>>
http://officetanaka.net/excel/vba/tips/tips31.htm
（まっつわん） 2018/05/15(火) 19:36

なぜかといわれますと、
私だけが使うなら作った本人なので大丈夫なのですが、
他の人もこれを使えるようにしたく、そうなった場合に、
複数シートを選択する場合、ユーザーフォームを使った方が
見やすい＆作業しやすくわかりやすいなと思ったので、
できればそちらを採用したいと思ったからです。
（ゾーマ） 2018/05/15(火) 19:46

　＞見やすい＆作業しやすくわかりやすいなと思ったので、
　＞できればそちらを採用したいと思ったからです。

なるほど、
シートを選択する操作方法の要望も結構高いですけど、
個人の感じ方の違いですね。

ならば、ぼくなら、問答無用でユーザーフォームを表示し、
それに、全シート選択の機能を追加するかな。
（チェックボックスにチェックを入れて全選択するようにするか、
全シート選択用のコマンドボタンを用意するかは悩ましいところですが。）
頭につけるブック名もそれを入力する用のテキストボックスを用意しておけばいいですよね？

（まっつわん） 2018/05/15(火) 20:03

まっつわんさん
なるほど、その考えは思いつきませんでした。
たしかにせっかくユーザーフォームなのですから全部設置できますね。
ありがとうございます

この選んだシートだけ分割保存ができるようになったら試してみます。

（ゾーマ） 2018/05/15(火) 20:13

コメント返信：

[ 一覧(最新更新順) ]

[[20180511152458]] 『一部シートのみ実行したい。』（ゾーマ） ページの最後に飛ぶ

[[20180511152458]]　『一部シートのみ実行したい。』（ゾーマ）　ページの最後に飛ぶ