[[20230322073532]] 『リストボックスから複数シートをコピー』(サン) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『リストボックスから複数シートをコピー』(サン)

ExcelB内のマクロで、
ExcelAのシートをユーザーフォームのリストボックスに表示させ
選択した2つのシートをExcelBにコピーしたいです。

現在下記のコードで1つ目のシートをコピーすることはできているのですが2つめのシートを持ってこれません。
2つ目の★のところで「インデックスが有効範囲にありません」と表示されます。

現在勉強中なのでどなたかご教授お願いします。

以下ユーザーフォーム内のコードです。
Private Sub CommandButton1_Click()

   Dim i As Long
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Worksheets(ListBox1.List(i)).Copy after:=ThisWorkbook.Worksheets(1)'…★
        End If
    Next i

    Unload UserForm1

End Sub

Private Sub UserForm_Initialize()

Dim ML() As Variant
Dim i As Integer

    With UserForm1.ListBox1

        .MultiSelect = fmMultiSelectMulti
        .ListStyle = fmListStyleOption

        ReDim Preserve ML(Sheets.Count)

        For i = 1 To Sheets.Count
            ML(i) = Sheets(i).Name
        Next i

        For i = 1 To UBound(ML)
            .AddItem ML(i)
        Next i

    End With

End Sub

< 使用 Excel:Excel2019、使用 OS:Windows10 >


勘違いしていたらごめんなさいですが↓はあらかじめ設定しておけばよい話なのでは?
    With UserForm1.ListBox1
        .MultiSelect = fmMultiSelectMulti
        .ListStyle = fmListStyleOption

さらに、変数に一旦格納せずとも直接リストボックスに追加すればよさそうな気がします。
すなわち、こんな感じです。

    Private Sub UserForm_Initialize()
        Dim ws As Worksheet

        For Each ws In ThisWorkbook.Sheets
            ListBox1.AddItem ws.Name
        Next ws
    End Sub

そのうえで、↓のようにしてテストしてみましたが、特に問題は生じませんでした。
MsgBoxでなくてもよいですが、どのシートを指定しているのか念のため確認してみてはどうでしょうか?

    Private Sub CommandButton1_Click()
       Dim i As Long
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                MsgBox ListBox1.List(i) & "をコピーします"
                Worksheets(ListBox1.List(i)).Copy after:=ThisWorkbook.Worksheets(1) '…★
            End If
        Next i
        'Unload UserForm1
    End Sub

(もこな2) 2023/03/22(水) 08:01:44


ふと思いましたが、シート名が数字になっていて、エクセル君にインデックス番号で指定したと誤解されているとかは無いでしょうか?

(もこな2) 2023/03/22(水) 08:42:47


もこな2様
ご回答ありがとうございます。

>.MultiSelect = fmMultiSelectMulti
>.ListStyle = fmListStyleOption
プロパティから設定変更しました。

>どのシートを指定しているのか念のため確認してみてはどうでしょうか?
1シート目のコピー後、2シート目のシート名までは確認できたのですが
やはりコピーの箇所(★)で同じエラーになります…。

仰る通り、コピーしたいシート名は数字で「1〜5」「5.5〜6」の書き方をしています。
が、仮でシート名をひらがなに変更してみても同じところでエラーが出てしまいます。
(サン) 2023/03/22(水) 12:34:57


 横から失礼します。

 このマクロはExcelB内のマクロで、ExcelAのシートをExcelBへコピーするのが目的ですよね。
 >Worksheets(ListBox1.List(i)).Copy after:=ThisWorkbook.Worksheets(1)
 ~~~~~~~~~~
   ↑この部分にブックの指定が無いので、自ブックのシートとなってしまいエラーとなっているのでは?
 正しくブック指定を入れれば直るのではないでしょうか。

(めいぷる) 2023/03/22(水) 13:02:59


話が進んでますが何点か。

■1
>コピーしたいシート名は数字で「1〜5」「5.5〜6」の書き方をしています。
>仮でシート名をひらがなに変更してみても同じところでエラーが出てしまいます。
シート構成(シート名と順番)を正確に提示できませんか?

一応こちらで↓のような実験をしてみましたが正常に動作してます。

【標準モジュール】

    Sub 実験用()
         Dim buf As Variant

         With Workbooks.Add
            For Each buf In Split("1,2,3,4,5,5.5,6", ",")
                .Worksheets.Add(after:=.Worksheets(.Worksheets.Count)).Name = buf
            Next buf

            .SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\実験用01.xlsx"
        End With
    End Sub

【ユーザーフォームモジュール】

    Private Sub UserForm_Initialize()
        Dim ws As Worksheet
        For Each ws In Workbooks("実験用01.xlsx").Sheets
            ListBox1.AddItem ws.Name
        Next ws
    End Sub
    '=======================================
    Private Sub CommandButton1_Click()
       Dim i As Long
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                MsgBox ListBox1.List(i) & "をコピーします"
                'Workbooks("実験用01.xlsx").Worksheets(ListBox1.List(i)).Copy after:=Workbooks("実験用01.xlsx").Worksheets(1)
                '↑で問題なかったが、念のためシート名に""をくっつけて強制的に文字列に変換
                Workbooks("実験用01.xlsx").Worksheets(ListBox1.List(i) & "").Copy after:=Workbooks("実験用01.xlsx").Worksheets(1)

            End If
        Next i
        Unload UserForm1
    End Sub

■2
>この部分にブックの指定が無いので〜
なるほど。ずっと自ブック(アクティブブック)を処理対象にしている前提で考えていましたが、確かにその可能性もありますね・・・

(もこな2) 2023/03/22(水) 15:06:11


めいぷる様、もこな2様
ご教授いただいたとおり指定したら無事にコピーができました!
早い返信で本当に助かりました。ありがとうございました。
(サン) 2023/03/23(木) 19:04:50

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.