| 
    
     |  | ▼ととりん さん: おはようございます。
 
 >
 >おはようございます。早々の解答ありがとうございました。
 >
 >選択しているリストの数は無事確認できました。
 >しかし。。。 どうもしてもやりたいと思っていたことができません。
 >
 >実は、複数選択しているシートを新しいブックにコピーしたいのですが、
 >上手くいきません。
 >
 >当初、下記のコードを考えたのですが、どうしてもワークシート枚数分ループするため
 >最終のシートを選択したときには、シート名の後に[,]はつきませんが、それ以外は付いてしまい、
 >シートの選択が上手くいかないのです。
 >
 >そこで、選択したシート枚数分のループを行うことを考え、選択しているシートの数の数え方を質問しましたが、
 >どうも、根本的に間違っているのか...
 >こんがらがってしまいました。
 >
 >よろしければ、どうすれば、リストボックスで複数選択したシートを
 >新しいブックにコピーすることが出来るのか教えていただけませんでしょうか?
 >よろしくお願いいたします。
 >
 >
 >'コマンドボタンクリック時
 >Private Sub CommandButton1_Click()
 >
 >  Dim theItem As String
 >  Dim i, t As Integer
 >
 >
 >  t = Worksheets.Count
 >  i = 0
 >
 >  Do
 >    If i <= t - 1 Then
 >
 >      If ListBox1.Selected(i) = True Then
 >       theItem = theItem & ListBox1.List(i) + ","
 >      End If
 >    ElseIf i = t - 1 Then
 >      If ListBox1.Selected(i) = True Then
 >        theItem = theItem & ListBox1.List(i) '---1
 >      End If
 >    End If
 >    i = i + 1
 >  Loop Until i = t
 >
 >  Sheets(theItem).Select
 >  Sheets(theItem).Copy
 >
 >End Sub
 ↑これだとリストボックスの最後のメンバを選択しない限り、1の処理はおこないませんよ。
 又、Sheets()内は、シート名のカンマ区切りの文字列で選択できましたっけ?
 (マクロの記録を使って確認して下さい)
 
 以下のようにして確認して下さい。
 '=========================================================
 Private Sub CommandButton1_Click()
 Dim theItem() As String
 Dim i As Integer
 Dim sdx As Long
 sdx = 0 '選択してメンバ数
 With ListBox1
 For i = 0 To .ListCount - 1
 If .Selected(i) = True Then
 ReDim Preserve theItem(sdx)
 theItem(sdx) = .List(i)
 sdx = sdx + 1
 End If
 Next i
 End With
 If sdx > 0 Then
 With ThisWorkbook
 'コピーが目的ならSelectの必要はありませんよ
 .Sheets(theItem()).Copy
 End With
 End If
 Erase theItem()
 End Sub
 
 
 |  |