最終行に追加で転記していくコードへの書き換えを教えてほしい

Question

実現したいこと

以前「VBAでの部分一致検索の仕方」という質問をさせていただいた際にご教授いただいたコードの内容を一部変更し、検索結果を残しつつ最終行に追記していく形にしたいです。

勉強不足で申し訳ないのですが、助けていただきたいです。

発生している問題・分からないこと

現在のコードでは検索結果を上書きしていく形になっていますが、最終行に追記することで検索結果を残していくようにしたいと考えています。
下記コード(以前質問させていただいた際にご教授いただいたもの)をご覧いただきたいのですが、出力領域のコードを削除すればよいのではと思い試してみましたが、だめでした。

'出力領域クリア
    If cmax2 >= 12 Then
        ws2.Range("A12:M" & cmax2).ClearContents

該当のソースコード

Option Explicit

'共有変数
Dim ws1 As Worksheet, ws2 As Worksheet
    Dim cmax1 As Long, cmax2 As Long
    Dim torihiki As String
    Dim bihin1 As String
    Dim bihin2 As String
    Dim startdate As Date, enddate As Date
    Dim flag(4) As Boolean
    Dim row2 As Long   '検索結果出力行

Public Sub AND検索()
    Call 検索処理("AND")
End Sub

Public Sub OR検索()
    Call 検索処理("OR")
End Sub

Private Sub 検索処理(ByVal joken As String)
    Const Folder As String = "D:\goo\data9"    'ブック格納フォルダ
    Dim wb As Workbook
    Dim bname As Variant: bname = Array("01_昭和分管理簿.xlsx", "02_平成分管理簿.xlsx", "03_令和分管理簿.xlsx")
    Dim sname As Variant: sname = Array("部署1", "部署2", "部署3")
    Dim i As Long
    Dim j As Long
    Application.ScreenUpdating = False
    Set ws2 = ThisWorkbook.Worksheets("検索と抽出")
    '各シートの最終行を取得
    cmax2 = ws2.Range("A1048576").End(xlUp).row
    '出力領域クリア
    If cmax2 >= 12 Then
        ws2.Range("A12:M" & cmax2).ClearContents
    End If
    '購入先を取得
    torihiki = ws2.Range("C2").Value

    '購入品の種類1を取得
    bihin1 = ws2.Range("C3").Value

    '購入品の種類2を取得
    bihin2 = ws2.Range("C4").Value

    '開始日と終了日を取得
    startdate = ws2.Range("C5").Value
    enddate = ws2.Range("C6").Value

    For i = 0 To UBound(flag)
        flag(i) = False
    Next
    '検索項目が空欄か判定
    If torihiki = "" Then flag(0) = True
    If bihin1 = "" Then flag(1) = True
    If bihin2 = "" Then flag(2) = True
    If startdate = 0 Then flag(3) = True
    If enddate = 0 Then flag(4) = True
    '変数初期化
    row2 = 12
    '３ブックを処理
    For i = 0 To UBound(bname)
        Dim path As String
        path = Folder & "\" & bname(i)
        Set wb = Workbooks.Open(path)
        '３シートを処理
        For j = 0 To UBound(sname)
            Set ws1 = wb.Worksheets(sname(j))
            '１シートを検索
            Call FindProc(joken)
        Next
        wb.Close
    Next
    Application.ScreenUpdating = True
End Sub
'1シートの検索
Private Sub FindProc(ByVal joken As String)
    cmax1 = ws1.Range("A1048576").End(xlUp).row
    Dim ret As Boolean
    Dim row1 As Long
    For row1 = 3 To cmax1
        If joken = "AND" Then
            ret = FindAND(row1)
        Else
            ret = FindOR(row1)
        End If
        If ret = True Then
            '条件に合致した行のデータのみを対象して分析
            ws1.Range("A" & row1 & ":M" & row1).Copy
            ws2.Range("A" & row2 & ":M" & row2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
            row2 = row2 + 1
        End If
    Next
    '合計値と件数を出力
    ws2.Range("C8").Value = Application.WorksheetFunction.CountA(ws2.Range("A12:A1048576"))
End Sub
'AND 検索(True:マッチ,False:アンマッチ)
Private Function FindAND(ByVal row1 As Long) As Boolean
    FindAND = False
        If flag(0) = False Then
            If InStr(1, ws1.Range("C" & row1).Value, torihiki, vbTextCompare) = 0 Then Exit Function
        End If
        
        If flag(1) = False Then
            If InStr(1, ws1.Range("E" & row1).Value, bihin1, vbTextCompare) = 0 Then Exit Function
        End If
        
        If flag(2) = False Then
            If InStr(1, ws1.Range("F" & row1).Value, bihin2, vbTextCompare) = 0 Then Exit Function
        End If
        
        If flag(3) = False Then
            If ws1.Range("K" & row1).Value = "" Then Exit Function
            If ws1.Range("K" & row1).Value < startdate Then Exit Function
        End If
        
        If flag(4) = False Then
            If ws1.Range("L" & row1).Value = "" Then Exit Function
            If ws1.Range("L" & row1).Value > enddate Then Exit Function
        End If
        FindAND = True
End Function
'OR 検索(True:マッチ,False:アンマッチ)
Private Function FindOR(ByVal row1 As Long) As Boolean
    FindOR = True
    If flag(0) = False Then
        If InStr(1, ws1.Range("C" & row1).Value, torihiki, vbTextCompare) > 0 Then Exit Function
    End If

    If flag(1) = False Then
        If InStr(1, ws1.Range("E" & row1).Value, bihin1, vbTextCompare) > 0 Then Exit Function
    End If

    If flag(2) = False Then
        If InStr(1, ws1.Range("F" & row1).Value, bihin2, vbTextCompare) > 0 Then Exit Function
    End If

    If flag(3) = False Then
        If ws1.Range("K" & row1).Value <> "" Then
            If ws1.Range("K" & row1).Value >= startdate Then Exit Function
        End If
    End If

    If flag(4) = False Then
        If ws1.Range("L" & row1).Value <> "" Then
            If ws1.Range("L" & row1).Value <= enddate Then Exit Function
        End If
    End If
    FindOR = False
End Function

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

検索の仕方が悪いのか、希望する形になるものを見つけることができませんでした。

補足

特になし

Comments

[meg_]

やりたい事をやるには多少の勉強は必要だと思います。一度入門書等で一通りExcelVBAを学習されるのが結局は近道かと思います。

[shibakoppe]

>>meg_様
おっしゃる通りだと思います。
ご助言ありがとうございます。

[meg_]

row2 = 12 を row2 = cmax2 + 1 にしたらどうでしょうか？

[shibakoppe]

>>meg_様
ご助言に加え、ご回答までいただき、本当にありがとうございました。
慌てていたとはいえ、見落としも多くご迷惑をおかけしました。

Answer 1

ざっと目を通して出力に関係する部分を抜き出すと下記。

'共有変数
    Dim row2 As Long   '検索結果出力行

    '変数初期化
    row2 = 12

            ws2.Range("A" & row2 & ":M" & row2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
            row2 = row2 + 1

row2を12で初期化しているので常に12行目からの出力になります。
ここを最終行+１で初期化するように変更するようすればいいでしょう。

最終行の取得に関しては、ググれば出てきますし、質問のコード内の下記でも使ってますね。

    '各シートの最終行を取得
    cmax2 = ws2.Range("A1048576").End(xlUp).row

これだけヒントを出せばあとはできますよね。

コメントにもあるようにExcelVBAの基礎をまずは勉強するのが結局早道になると思います。

Comments

[shibakoppe]

>>hatena19様
お世話になります。
ご回答いただきありがとうございます。
meg_様にもご回答いただきましたが、回答欄にご回答いただいたhatena19様にベストアンサーを送らせていただきます。
無事、解決できました。
自信の甘さを反省し、基礎からしっかりと勉強しようと改めて思いました。
お二方、本当にありがとうございました。