【VBA】特定の文字が入っている行の一部を抽出して別シートコピーするには

VBA初心者です。
色々と検索したのですが、似たような内容が見つけられず教えていただきたいです。

条件を満たす行の一部をとなりのシートにコピーしたいです。


【シート1】※データシート
　　A 　　　B 　　　 C 　　　　　　　D 　　　　E 　　　　F 　　G
　会員番号/会員ランク/会員登録日　/　氏名　/都道府県/住所1/謎の文言列
　1 　　　プラチナ 　　2010/1/10 　あ 　　東京都 　　東 　あい78あいあ

【シート2】※抽出結果の貼付けシート
　　A 　　　B 　　　 C 　　　　　　　D 　　
　会員番号/会員ランク/会員登録日　/謎の文言列
　1 　　　プラチナ 　　2010/1/10 　あい78あいあ

シート1のC列が2020/1/10以降かつ　G列に　78　の文言を含む行を抽出し
その結果の会員番号、会員ランク、会員登録日、謎の文言列を隣のシート2に貼り付けたいです。

全くの初心者で申し訳ないのですがどうぞよろしくお願いいたします。

質問者からの補足コメント

• 

  ご質問ありがとうございます。
  ＞＞シート1のC列が2020/1/10以降かつ　G列に　78　の文言を含む行を抽出
  ＞その条件については固定or変動？
  C列は変動の予定です！
  月次の報告書をイメージしておりまして、報告対象月により変動します。
  
  2020年1月の報告書：2020/1/10以降
  2020年2月の報告書：2020/2/10以降
  シート2の　I1　に報告対象月（2020/1/10）を記入しております。
  
  G列は固定です。
  わかっていないものが質問しているので分かりにくくて本当に申し訳ないです・・・

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/05/29 13:38

• 先程お礼をさせていただいたばかりなのに申し訳ないです。
  
  YEAR(Sheet1!$C$2:$C$1000)>2019)
  こちらの部分を日にちに変更するにはどうすればよいのでしょうか。
  2020/1/13などか年だけでなく月日も指定したいです。
  
  よろしくお願いいたします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2020/05/29 15:58

No.5 ベストアンサー 回答者： tom04 回答日時： 2020/05/30 09:41

こんにちは！

横からお邪魔します。
No.2さんが回答されているように関数でも可能だと思いますが、
VBAでの方法をご希望のようなので、一例です。

尚、元データはSheet1にあり、Sheet2に表示するとします。
（コード内のシート名は実際のシート名に変更してください）

そして、「日付」や「検索文字」は決め打ちすると汎用性がないので
インプットボックスにその都度入力するようにしてみました。
標準モジュールにしてください。

Sub Sample1()
　Dim i As Long
　Dim lastRow As Long
　Dim wS As Worksheet
　Dim myDate As String, myStr As String

　　myDate = Application.InputBox("日付を「2020/3/14」のような形式で入力")
　　myStr = Application.InputBox("検索文字を入力")
　　Set wS = Worksheets("Sheet1")
　　　With Worksheets("Sheet2")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　If lastRow > 1 Then
　　　　　　Range(.Cells(2, "A"), .Cells(lastRow, "D")).ClearContents
　　　　　End If
　　　　　For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　If wS.Cells(i, "C") >= DateValue(myDate) Then
　　　　　　　If InStr(wS.Cells(i, "G"), myStr) > 0 Then
　　　　　　　　With .Cells(Rows.Count, "A").End(xlUp).Offset(1)
　　　　　　　　　.Value = wS.Cells(i, "A")
　　　　　　　　　.Offset(, 1) = wS.Cells(i, "B")
　　　　　　　　　.Offset(, 2) = wS.Cells(i, "C")
　　　　　　　　　.Offset(, 3) = wS.Cells(i, "G")
　　　　　　　　End With
　　　　　　　End If
　　　　　　End If
　　　　　Next i
　　　　.Activate
　　　End With
MsgBox "完了"
End Sub

※　Sheet2の日付列は好みの表示形式にしておいてください。

※　注意点　※
仮に検索文字が「78」だとし、G列が「178」とか「75785」のような場合でも表示されてしまいます。m(_ _)m

この回答へのお礼

わーい！！わーい！！すごーい！インプットボックスいいですね！
そうかそうか。こういう方法もあるんですね。
ささっとこんなコードがかけるなんて、もっと勉強したくなってきました。
本当にありがとうございます。

お礼日時：2020/06/01 13:45

No.4 回答者： ママチャリ 回答日時： 2020/05/30 09:10

VBAなら、AdvancedFilterメソッドが便利です。

添付画像のような「抽出条件」シートを用意する必要があるのですが、条件（例えば日付）を変える場合など、そのシートの値を変えるだけでOKです。

Sub sample()
Sheets("日本会員").Columns("A:G").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("抽出条件").Range("A1:B2"), _
CopyToRange:=Sheets("書き出したシート").Range("A1:D1"), _
Unique:=False
End Sub

ちなみに、「抽出条件」シートの値は、次のように設定しています（値をそのまま設定するのではなく、数式として設定します）。

A2セル　=">=2020/06/02"
B2セル　="*78*"

この回答へのお礼

抽出条件シート！そういう考え方もあるんですね。勉強になります！

お礼日時：2020/06/01 13:54

No.3 回答者： fujillin 回答日時： 2020/05/29 16:49

No2です

＞こちらの部分を日にちに変更するにはどうすればよいのでしょうか。
大変失礼いたしました。当方がご質問文を読み違えてしまったようです。

＞YEAR(Sheet1!$C$2:$C$1000)>2019
は、ご指摘の通り「年」だけを条件にしてしまっています。

また、
＞シート2の　I1　に報告対象月（2020/1/10）を記入しております。
とのことですので、 I1セルの値を用いるようにした方が、汎用性が増しますね。
上記の部分を（YEARから2019まで）
　Sheet1!$C$2:$C$1000 >= $I$1
に置き換えれば、I1 以降の日が検索の対象になります。
（I1 を含むか含まないかは「=」の有無で調節願います）

ついでながら、もう一つの条件の "78" の方も可変になさりたい場合は、式中の "78" の部分を値の入っているセルの絶対参照に変えることで可能になります。

この回答へのお礼

ありがとうございます♪ホントだー！できました！！！
関数でもできるっていうのが本当に勉強になりました。

お礼日時：2020/06/01 13:55

No.2 回答者： fujillin 回答日時： 2020/05/29 13:26

こんにちは

VBAのご質問ですが、関数でもできそうなので・・・
VBAでの回答は（多分）No1様がなさってくださると思います。

元シート（=Sheet1）のC列の日付は日付型（=シリアル値）と仮定しています。
シート２のA2セルに以下の式を記入して、右方、下方にフィルコピーします。

=IFERROR(INDEX(OFFSET(Sheet1!$A:$A,,INDEX({0,1,2,6},COLUMN(A1))),AGGREGATE(15,6,ROW(A$2:A$1000)/(YEAR(Sheet1!$C$2:$C$1000)>2019)/(FIND("78",Sheet1!$G$2:$G$1000)>0),ROW(A1))),"")

※ 関数式を利用する利点は、データに変更があった際に自動的に反映されること。
　 欠点は、式が複雑になりやすいので、関数式のメンテがしにくいことでしょうか。

No.1 回答者： めぐみん_ 回答日時： 2020/05/29 12:55

転記する項目は一定の物であるとしても、

＞シート1のC列が2020/1/10以降かつ　G列に　78　の文言を含む行を抽出

その条件については固定or変動？
変動であればその条件の書き込むめぼしは立っているの？