エクセル マクロで質問です

エクセル：シート１で、B列に有る同じ値を　抽出（例　３）して、行A～H全てをシート２へ貼り付けたいです
　　　　　
Sheet 1
　　　　　　A　　　B　　　C　　　D　　　E　　　F　　　G　　　H
　　　　１　１　　5　　　リンゴ　100　
　　　　２　１　　8　　　リンゴ　150
　　　　３　１　　6　　　リンゴ　180
　　　　４　５　　7　　　梨
　　　　５　６　　3　　　ぶどう　
　 　 　 ６　 7　　3 みかん

　　　
Sheet ２

A　　　B　　　C　　　D　　　E　　　F　　　G　　　H
　　 　1 　６ 　 3　　ぶどう　
　　 2　 7　 3 みかん



宜しくおねがい致します

No.1 回答者： tom04 回答日時： 2017/10/21 19:37

こんばんは！

質問文を拝見すると1行目からデータがあるように書いてありますね？
1行目が項目行であれば、単純にオートフィルタで対応できると思うのですが・・・

一例です。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, cnt As Long, lastCol As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If .Cells(i, "B") = 3 Then
cnt = cnt + 1
lastCol = .Cells(i, Columns.Count).End(xlToLeft).Column
wS.Cells(cnt, "A").Resize(, lastCol).Value = .Cells(i, "A").Resize(, lastCol).Value
End If
Next i
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

No.2 ベストアンサー 回答者： tom04 回答日時： 2017/10/21 19:41

No.1です。

＞行A～H全てをシート２へ貼り付けたいです
でしたね。
どうも失礼しました。
前回のコードは消去し↓のコードにしてください。

Sub Sample2()
Dim i As Long, cnt As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
If .Cells(i, "B") = 3 Then
cnt = cnt + 1
.Cells(i, "A").Resize(, 8).Copy wS.Cells(cnt, "A")
End If
Next i
End With
End Sub

どうも失礼しました。m(_ _)m

No.3 回答者： tatsu99 回答日時： 2017/10/21 20:30

もし、７行目にB列が５のデータ

　　A　B　　C
7　８　５　梨　・・・・
があれば、５も出力するのですか。
以下のように
A 　B　C　D　E　F
１　５　リンゴ
６　３　ぶどう
７　７　みかん
８　５　梨

この回答へのお礼

一応、１～１９までをシート毎に仕訳みたいにして行くのでマクロかなぁと思ってましたが出来なく
更に８００～９００行のエクセルがいくつもあり、気が遠くなってましたが、助かりました。

ありがとうございます

お礼日時：2017/10/21 23:08