[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『リストボックスから複数シートをコピー』(サン)
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
>.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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.