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

実行したいこと
１．リストBOXで全Sheetを表示する。
２．リストBOXからSheetを選択させる(複数可)
３．リスト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 -
引用なし
パスワード
   ▼とってぃ さん：
>実行したいこと
>１．リストBOXで全Sheetを表示する。
>２．リストBOXからSheetを選択させる(複数可)
>３．リスト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 さん：
>▼とってぃ さん：
>>実行したいこと
>>１．リストBOXで全Sheetを表示する。
>>２．リストBOXからSheetを選択させる(複数可)
>>３．リスト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