ここから本文です

Excel VBA 条件にあったセル行のデータを別シートへ貼り付けるマクロ シート上...

ebi********さん

2017/12/202:10:12

Excel VBA 条件にあったセル行のデータを別シートへ貼り付けるマクロ

シート上にコンボボックスとコマンドボタンを設定しています。

コンボボックスの値がI列と一致したとき、その該当するセル行(A~Iまで)
そのまま別シートに貼り付けたいのですが、エラーが出てしまいます。
どこがまずいのか教えていただきたいです。
もっと効率的なコードがあればよろしければ教えていただきたいです。
よろしくお願いいたします。
----------------------------------------------------------------------------------------------------
Sub CommandButton_Click()

Dim lastRow As Long
Dim Wsh As Worksheet
Dim i As Long

lastRow = Wsh.Cells(Rows.Count, 1).End(xlUp).Row

Worksheets("Words").Range(Cells(2, 1), Cells(lastRow, 10)).ClearContents

With Worksheets("Words")

For i = 1 To lastRow
If Worksheets("Database").Cells(i, 10).Value = ComboBox1.Value Then
* Worksheets("Database").Rows(i).Copy Worksheets("Words").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

あるいは↓で出来たらと思い、両方試しました。

* Worksheets("Words").Range(Cells(lastRow, 1), Cells(lastRow, 10)).Value = Worksheets("Database").Range(Cells(i, 1), Cells(i, 10)).Value
End If
Next i

End With

End Sub

閲覧数:
111
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

ask********さん

2017/12/204:54:48

いくつか指摘を

lastRow = Wsh.Cells(Rows.Count, 1).End(xlUp).Row
--------------
Wsh に シートを代入する記述がないためエラーになります。

Set Wsh = Worksheets(....
-------------
lastRow = ...の箇所でエラーになるので以降の処理は行われませんが、記述がおかしい箇所がいくつかあります。

Worksheets("Words").Range(Cells(2, 1), Cells(lastRow, 10)).ClearContents

lastRow を、 Words シートにあったデータを消去する範囲の行指定として使用しているので、lastRow = (データを消去する前の)Wordsシートのデータ最終行となります。

----------------------
For i = 1 To lastRow

ところが、ここでまた同じ値を使用しています。

このループ記述では、DatabaseシートのCells(i,10)がコンボボックスの値と一致しているかの判定を行っているので、変数 i の 繰り返し回数に lastRowをそのまま使用すると、Databaseシートの最終行に行く前にループが終了してしまいます。

Databaseシートはマスタデータだと思うので、行数はWordsシートより多いはずです。

----------------------
コンボボックス、コマンドボタンをDatabaseシートに配置してある場合は、こんな感じにすればコピペできます。

Private Sub CommandButton1_Click()
Dim lastRow As Long
Dim Wsh As Worksheet
Dim i As Long

lastRow = Me.Cells(Rows.Count, 1).End(xlUp).Row
'Database のA列最終行

Set Wsh = Worksheets("Words")

Wsh.Cells.Clear
Me.Range("a1:j1").Copy Wsh.Range("a1")

For i = 1 To lastRow
If Me.Cells(i, 10).Value = ComboBox1.Value Then
Me.Cells(i, 1).Resize(, 10).Copy Wsh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next
MsgBox "転記しました"
End Sub

---------------------------
以下コードは、フィルタの詳細設定で転記します。
DatabaseシートのL1:L2を、フィルタの抽出条件範囲として使用しています。

Private Sub CommandButton1_Click()
Dim Wsh As Worksheet
Dim lastRow As Long

Set Wsh = Worksheets("Words")
Wsh.Cells.Clear

Me.Range("L1").Value = Range("J1").Value
Me.Range("L2").Value = ComboBox1.Value
'L2に、コンボボックスの値を入れる。

lastRow = Me.Cells(Rows.Count, 1).End(xlUp).Row

Me.Range("a1").Resize(lastRow, 10).AdvancedFilter _
xlFilterCopy, Me.Range("L1:L2"), Wsh.Cells(1)

Wsh.Range("a1").CurrentRegion.Columns.AutoFit
MsgBox "転記しました"
End Sub

※添付図はDatabaseシートです。

いくつか指摘を

lastRow = Wsh.Cells(Rows.Count,...

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この質問は投票によってベストアンサーに選ばれました!

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる