シート間の条件付き行コピーと重複データ対応

前提・実現したいこと

シート1からシート2へ特定文字を含む行をコピー・転記し、内容が重複するものはデータを上書きする方法探しています。
＜シート1＞
|A|B|C|D|E|F|G|H|I|J|
|:--|:--|:--|:--|:--:|--:|:--|:--:|--:|
|1|日付|所属|客先|役職|氏名|氏名2|氏名3|進捗|内容|
|2|

1行目に項目で2行目以降は各フォルダから吸い上げたデータが並んでいます。

＜シート2＞
|A|B|C|D|E|F|G|H|I|J|
|:--|:--|:--|:--|:--:|--:|:--|:--:|--:|
|1|日付|所属|客先|役職|氏名|氏名2|氏名3|進捗|内容|
|2|

フォーマットはシート1と一緒です。

＜条件＞
シート1のH列に”訪問”と入っている行を抽出し、シート2の2行目以降に反映。
反映時にシート2に重複するデータ(行)があれば上書きする

発生している問題・エラーメッセージ

重複するデータも抽出し反映している。
1行目の項目欄にも反映してしまっている。

該当のソースコード

Sub 訪問企業()
Dim wbRead As Workbook
Dim wbOut As Workbook
Dim shtRead As Worksheet
Dim shtOut As Worksheet

Set wbRead = ActiveWorkbook
Set wbOut = Workbooks("集計.xlsm")
Set shtRead = wbOut.Worksheets("全体")
Set shtOut = wbOut.Worksheets("訪問")

Dim rng As Range
Dim lastRow As Long

'現在のブック内にあるすべてのシートをループ処理
For Each shtRead In wbRead.Worksheets
'対象シート内のH列先頭からH列最終データ行までをループ処理
For Each rng In shtRead.Range(shtRead.Cells(8, 1), shtRead.Cells(shtRead.Rows.Count, 1).End(xlUp))
'H列が「訪問」なら、
If shtRead.Cells(rng.Row, 8) = "訪問" Then
'読込シートから行コピー
shtRead.Rows(rng.Row).Copy

            'A~J列全体から、重複データを探して、選択する。
            Dim KENSAKU As Variant
            KENSAKU = shtRead.Range("A1:J63000")
            Dim FoundCell As Range
            Set FoundCell = shtOut.Range("A:J").Find(What:=KENSAKU, LookAt:=xlWhole)

            '【重複ない場合】空白の行に内容を転記
            If FoundCell Is Nothing Then
                'DBブックを選択し、一番下の行番号を取得
                lastRow = shtOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
                '出力シートに値で貼り付け
                shtOut.Rows(lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False

            '【重複ある場合】同じ検索用の内容の行に上書きする
            Else
                'その行に貼付け
                shtOut.Rows(FoundCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False

            End If
        End If
    Next rng
Next shtRead

Application.CutCopyMode = True
ActiveCell.Select

End Sub

試したこと

マクロ初心者でどこをいじればいいのか分かりません。

補足情報（FW/ツールのバージョンなど）

Windows7/Excel ver.10

行動規範の内容に同意します

回答2件

そもそも、VBAなど不要。
ピボットテーブルにするのもいいし、重複の削除の機能で十分。

図は、重複の削除の方法。

投稿2018/12/24 09:55

kai_keitai

総合スコア344

シート1からシート2へ特定文字を含む行をコピー・転記し、内容が重複するものはデータを上書きする方法探しています。

VBAが不要というのは極論だと思いますが、
VBAで自動化しなくても、エクセルの機能を使えば、
そんなに難しくなく、希望の結果が得られます。

希望の動作を実現するには、
「フィルターオプション」（今は公式には使われてない？なんていうんだろう？）
という機能で実現できます。
ただし、この機能を手動で行うには、シート上をかなり汚さないと
（イメージしている結果に関係ないことをシート上に書かないといけない。）いけないので、
敬遠されがちですが、VBAでその作業をやるなら、
自動で追記したり消したり自由自在ですので、そういうものを「見せない」ということができます。

（Excel2010のリボン上では、データタブ→並び替えとフィルター→詳細設定というボタンです。）

フィルターオプションという機能では、
別のシートに意図した行あるいは列だけコピー
重複の削除
という機能が内包されています（仕様を確認のこと）ので、
希望の結果を得るのに非常に少ないコード量で開発ができます。
（その代り作業用のシートを用意したりしなければいけないですが）
ぜひ、検討してみてください。

参考URL>>
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_advancedfilter.html

投稿2018/12/25 13:25