Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3038 / 13644 ツリー ←次へ | 前へ→

【64654】リストBOXからSheetをコピーしたい(複数枚) とってぃ 10/3/2(火) 9:32 質問[未読]
【64655】Re:リストBOXからSheetをコピーしたい(複数... 超初心者 10/3/2(火) 9:59 発言[未読]
【64657】Re:リストBOXからSheetをコピーしたい(複数... とってぃ 10/3/2(火) 10:57 お礼[未読]
【64656】Re:リストBOXからSheetをコピーしたい(複数... Yuki 10/3/2(火) 10:29 発言[未読]
【64658】Re:リストBOXからSheetをコピーしたい(複数... とってぃ 10/3/2(火) 10:58 お礼[未読]

【64654】リストBOXからSheetをコピーしたい(複数...
質問  とってぃ E-MAIL  - 10/3/2(火) 9:32 -

引用なし
パスワード
   はじめまして。VBAの初心者です。
色々模索して考えたのですが下記コードだとリストBOXから複数枚
選択でコピー(コマンドボタン)実行で同一Sheetがコピーされます。

Private Sub UserForm_Initialize()
For i = 1 To Worksheets.Count
ListBox1.AddItem Worksheets(i).Name 
Next
End Sub

Private Sub CommandButton1_Click()
Dim i As Integer
Dim myName As String

With ListBox1
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
Worksheets(.List(.ListIndex)).Select
pasu = ActiveWorkbook.Path
ActiveSheet.Copy
myName = ActiveSheet.Name
End If
Next i
End With
End Sub

実行したいこと
1.リストBOXで全Sheetを表示する。
2.リストBOXからSheetを選択させる(複数可)
3.リストBOXで選択したSheetをコマンドボタンで新しいBookにコピーする。
以上です。

【64655】Re:リストBOXからSheetをコピーしたい(複...
発言  超初心者  - 10/3/2(火) 9:59 -

引用なし
パスワード
   ▼とってぃ さん:

> Private Sub CommandButton1_Click()
>   Dim i As Integer
>   Dim myName As String
>   Dim pasu As String
   Dim myBook As Workbook
>  
   Set myBook = ActiveWorkbook
>   With ListBox1
>     For i = 0 To ListBox1.ListCount - 1
>       If ListBox1.Selected(i) Then
         myBook.Activate
>> '       Worksheets(.List(.ListIndex)).Select
         Worksheets(.List(i)).Select
>         pasu = ActiveWorkbook.Path
>         ActiveSheet.Copy
>         myName = ActiveSheet.Name
>       End If
>     Next i
>   End With
> End Sub

こんな感じでいかがでしょう。

【64656】Re:リストBOXからSheetをコピーしたい(複...
発言  Yuki  - 10/3/2(火) 10:29 -

引用なし
パスワード
   ▼とってぃ さん:
>実行したいこと
>1.リストBOXで全Sheetを表示する。
>2.リストBOXからSheetを選択させる(複数可)
>3.リストBOXで選択したSheetをコマンドボタンで新しいBookにコピーする。
>以上です。

Private Sub CommandButton1_Click()
  Dim i  As Long
  Dim j  As Long
  Dim s() As String
  
  With Me.ListBox1
    For i = 0 To .ListCount - 1
      If .Selected(i) Then
        ReDim Preserve s(j)
        s(j) = .List(i)
        j = j + 1
      End If
    Next
  End With
  ' 選択したシート全部の新ブックが出来る
  Worksheets(s).Copy
End Sub

【64657】Re:リストBOXからSheetをコピーしたい(複...
お礼  とってぃ E-MAIL  - 10/3/2(火) 10:57 -

引用なし
パスワード
   超初心者 さんありがとうございました。
無事にうまくいきました。

▼超初心者 さん:
>▼とってぃ さん:
>
>> Private Sub CommandButton1_Click()
>>   Dim i As Integer
>>   Dim myName As String
>>   Dim pasu As String
>   Dim myBook As Workbook
>>  
>   Set myBook = ActiveWorkbook
>>   With ListBox1
>>     For i = 0 To ListBox1.ListCount - 1
>>       If ListBox1.Selected(i) Then
>         myBook.Activate
>>> '       Worksheets(.List(.ListIndex)).Select
>         Worksheets(.List(i)).Select
>>         pasu = ActiveWorkbook.Path
>>         ActiveSheet.Copy
>>         myName = ActiveSheet.Name
>>       End If
>>     Next i
>>   End With
>> End Sub
>
>こんな感じでいかがでしょう。

【64658】Re:リストBOXからSheetをコピーしたい(複...
お礼  とってぃ E-MAIL  - 10/3/2(火) 10:58 -

引用なし
パスワード
   Yuki さんありがとうございました。
見事です。また何かありましたらその時は回答お願い致します。

▼Yuki さん:
>▼とってぃ さん:
>>実行したいこと
>>1.リストBOXで全Sheetを表示する。
>>2.リストBOXからSheetを選択させる(複数可)
>>3.リストBOXで選択したSheetをコマンドボタンで新しいBookにコピーする。
>>以上です。
>
>Private Sub CommandButton1_Click()
>  Dim i  As Long
>  Dim j  As Long
>  Dim s() As String
>  
>  With Me.ListBox1
>    For i = 0 To .ListCount - 1
>      If .Selected(i) Then
>        ReDim Preserve s(j)
>        s(j) = .List(i)
>        j = j + 1
>      End If
>    Next
>  End With
>  ' 選択したシート全部の新ブックが出来る
>  Worksheets(s).Copy
>End Sub

3038 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free