同じ様式の表の複数シートから行ごと抽出

質問

A2:K12の範囲に表がある全く同じ様式のシートが複数あります。
特定の条件が満たされた行を全て別シートに抽出したいです。
1列目と2列目とX列目(これは集計のA1セルに入った値を参照)が空白でない行を全て抽出したいです。1列目と2列目は1行目から順番に埋まっているのですが、X列目は空白になっているものと空白でないものが混在しています。
たとえば、Xが10列目のときは、Aさん、Bさん、Cさん、Dさん、Eさんの行が抽出されるようにしたいです。
VBAのコードを自力で書けないので、よろしくお願いします。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.2

HohoPapa · ベストアンサー

こうでしょうか？

Sub Sample1()

　Dim shCnter As Long
　Dim PutRCnt As Long
　Dim RCnt As Long
　Dim PicColNum As Long

　Const PutShNum = 1　'集計先シート番号
　Const GetShNumS = 2 '集計元シート群の先頭シート番号
　Const GetShNumE = 4 '集計元シート群の末尾シート番号

　PicColNum = ThisWorkbook.Sheets(PutShNum).Cells(1, 1).Value

　With ThisWorkbook
　　PutRCnt = 2
　　For shCnter = GetShNumS To GetShNumE
　　　For RCnt = 2 To 12
　　　　If ((.Sheets(shCnter).Cells(RCnt, 1).Value <> "") And _
　　　　　　(.Sheets(shCnter).Cells(RCnt, 2).Value <> "") And _
　　　　　　(.Sheets(shCnter).Cells(RCnt, PicColNum).Value <> "")) Then
　　　　　.Sheets(shCnter).Rows(RCnt).Copy .Sheets(PutShNum).Rows(PutRCnt)
　　　　　PutRCnt = PutRCnt + 1
　　　　End If
　　　Next RCnt
　　Next shCnter
　End With

End Sub

お礼

ご回答ありがとうございます。

回答No.1

山田 太郎（@f_a_007）

【参考意見】

　当方、先日までエクセルは開いたことも操作したこともない70歳になる爺です。ですから、エクセルのVBAなんて見たことも聞いたこともないド素人。その点を踏まえた私の回答を一瞥ください。

　質問の案件ですが、これは、（ある種のツールを使えば）VBAコードを書かずとも可能かと思います。でも、問題は、そのツールのソースコードの受け渡しの手段。多分、OKWaveが許可する行数では足りないでしょう。少なくとも、A4で7～8ページにはなるでしょうから・・・。

　一体、そのようなツールを使えば良いのかは、私のプロフィールで公開しているブログをチラリと覗いてください。

　一切のVBAコードを書かずとも可能・・・と言うことは、逆に言えば、《VBAコードを書かずとも可能にする命令文を書ける》と言うことが要求されます。なお、ブログ記事《No.16》で提示しているマクロぐらいは書けることは必要です。

Sub Test1()
　　Dim strSQL0 As String
　　Dim strSQL1 As String
　　Dim strSQL2 As String

　　strSQL1 = "SELECT * FROM [Sheet10$A1:C3] WHERE Len([Sheet10$A1:C3].列2 & '') >0"
　　strSQL2 = "SELECT * FROM [Sheet11$A1:C3] WHERE Len([Sheet11$A1:C3].列2 & '') >0"
　　strSQL0 = strSQL1 & " UNION " & strSQL2

　　Call SQLWriter(strSQL0, "Sheet12$A1")
End Sub

Sub Test2()
　　Dim strSQL1 As String
　　Dim strSQL2 As String

　　strSQL1 = "SELECT * FROM [Sheet10$A1:C3] WHERE Len([Sheet10$A1:C3].列2 & '') >0"
　　strSQL2 = "SELECT * FROM [Sheet11$A1:C3] WHERE Len([Sheet11$A1:C3].列2 & '') >0"

　　Call SQLWriter(strSQL1, "Sheet12$A1")
　　Call SQLWriter(strSQL2, "Sheet12$A1;ADD")
End Sub

　なお、マクロのTest1()とTest2()の実行結果は、微妙に違います。まあ、こういうやり方もあるってことです。

お礼

ご回答ありがとうございます。