複数選択可能なリストボックス

質問

Excel VBAの質問をさせてください。
シート(sheet1)のA列、セルA1から以下のデータがあるとします。
みかん
りんご
バナナ
苺
梨
バナナ
バナナ
みかん

フォームのリストボックスで"みかん"と"バナナ"を選択した際、シート(sheet2)のセルA1にコピーしていきたいのですが機能しません。
単品、"みかん"だけを選択しても何もコピーされません。
どこがいけないでしょうか??

Private Sub UserForm_Initialize()
　　With ListBox1
　　　　.AddItem "みかん"
　　　　.AddItem "りんご"
　　　　.AddItem "バナナ"
　　　　.AddItem "苺"
　　　　.AddItem "梨"
.MultiSelect = fmMultiSelectMulti
　　End With
End Sub

Private Sub CommandButton1_Click()

Dim i As Long
For i = 1 To 8

If Worksheets("Sheet1").Cells(i, "A").Value = Me.ListBox1.Value Then

Worksheets("Sheet1").Cells(i, "A").Copy Worksheets("Sheet2").Cells(i, "A")

End If

End Sub

回答No.2

ushi2015 · ベストアンサー

こんにちは
昨日の回答が全てですけど？
MultiSelect = fmMultiSelectMulti　で複数選択可能にされているので、
If Worksheets("Sheet1").Cells(i, "A").Value = Me.ListBox1.Value Then
は使えないです。
Me.ListBox1.Value がエラーになるはずです。

回答No.1

ushi2015

こんにちは
複数選択可能にしているので、何が選択されているか調べないとダメです。
Private Sub CommandButton1_Click()
　　Dim i As Long
　　Dim j As Long
　　Dim v()
　　Dim x As Variant
　　For i = 0 To Me.ListBox1.ListCount - 1
　　　　If Me.ListBox1.Selected(i) = True Then
　　　　　　ReDim Preserve v(i)
　　　　　　v(i) = CStr(Me.ListBox1.List(i))
　　　　End If
　　Next
　　For i = 1 To 8
　　　　x = Application.Match(Worksheets("Sheet1").Cells(i, "A").Value, v, 0)
　　　　If Not IsError(x) Then
　　　　　　j = j + 1
　　　　　　Worksheets("Sheet1").Cells(i, "A").Copy Worksheets("Sheet2").Cells(j, "A")
　　　　End If
　　Next
End Sub
同じデータも全部コピーするのでしょうか？
要件が良く分かりませんけど・・・

補足

同じデータもすべてコピーしていきます。
ありがとうございます。

大変申し訳ございませんが、他にもリストボックスがございまして、まず今回の↓条件を入れたいのですが
いただいたサンプルのどこの箇所でいれるのが適切でしょうか
いろいろ試しましたがうまくいきませんでした。

If Worksheets("Sheet1").Cells(i, "A").Value = Me.ListBox1.Value Then
.
End if