VBAで条件が一致する行のデータを別シートに抽出で…

質問

QNo.4034421『VBAで条件が一致する行のデータを別シートに抽出』の続きになります。
下記のような記述を前回ご教授賜っていたのですが、Keywrd"a"が無い場合、SubステートメントからExitではなく、
"Sheet2の"A387"の列を空白にしたまま次のプログラムに移行するように"Else"を使用して記述してみたのですが、上手くいきません。
ご教授願えませんでしょうか。

Dim Keywrd As String
Dim TargetCell As Range
Keywrd = "a"
If Keywrd = "" Then Exit Sub
With Worksheets("Sheet1").Columns("A:A")
Set TargetCell = .Find(Keywrd, LookAt:=xlWhole, LookIn:=xlValues)
If TargetCell Is Nothing Then
MsgBox Keywrd & " は見つかりません。"
Exit Sub
End If
End With
TargetCell.EntireRow.Copy Worksheets("Sheet2").Range("A387")
TargetCell.EntireRow.Delete Shift:=xlUp

回答No.1

keirika

If Not TargetCell Is Nothing Then
TargetCell.EntireRow.Copy Worksheets("Sheet2").Range("A387")
TargetCell.EntireRow.Delete Shift:=xlUp
End If

でどうでしょうか。

補足

上記を試してみましたが、集計プログラムが機能せず上手くいきませんでした。
前後の記述が影響しているかもしれません。
説明不足で申し訳ありません。

全体の流れは
TextBox1～4：予めWEBからエクスポートしたCSVファイルを選択
CommandButton3：TextBox1～4で選択したファイルを加工（不要なデータ削除やソートや集計統合）となっています。

前後の記述は下記のようになっております。

If TextBox3 = "" Then
MsgBox "この項目をスキップしてレポート作成します"
TextBox3.SetFocus
Windows("Report.xls").Activate
Sheets("a2元データ").Select
Cells.Select
Selection.ClearContents
Sheets("a2").Select
Range("B243:O252,B255:O264,B267:O276,B279:O288").Select
Range("B243:O252,B255:O264,B267:O276,B279:O288,B291:O300,B303:O312,B315:O324"). _
Select
Range( _
"B243:O252,B255:O264,B267:O276,B279:O288,B291:O300,B303:O312,B315:O324,B327:O336" _
).Select
Range( _
"B243:O252,B255:O264,B267:O276,B279:O288,B291:O300,B303:O312,B315:O324,B327:O336,B339:O348" _
).Select
Range( _
"B243:O252,B255:O264,B267:O276,B279:O288,B291:O300,B303:O312,B315:O324,B327:O336,B339:O348,B351:O360,B363:O372,B375:O384" _
).Select
Range( _
"B243:O252,B255:O264,B267:O276,B279:O288,B291:O300,B303:O312,B315:O324,B327:O336,B339:O348,B351:O360,B363:O372,B375:O384,B387:R387" _
).Select
Selection.ClearContents
Range("A1").Select
Else
Workbooks.OpenText TextBox3.Value, Local:=True
Cells.Select
Selection.Copy
Range("A1").Select
Windows("Report.xls").Activate
Sheets("a2元データ").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(2).Activate
Application.DisplayAlerts = False
ActiveWindow.Close SaveChanges:=False
Application.DisplayAlerts = True
'データの置換
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Replace What:="\", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A7").Select
'上部タイトル及び最下部合計値削除
Sheets("a2元データ").Select
Rows("1:6").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").End(xlDown).Select
ActiveCell.EntireRow.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
'データ個数カウント用
Range("P1").Select
ActiveCell.FormulaR1C1 = "データ個数"
ActiveCell.Characters(4, 2).PhoneticCharacters = "コスウ"
Range("P2:P" & Range("O65536").End(xlUp).Row).Select
Selection.FormulaR1C1 = "1"
Range("A1").Select
'"a"数値移行＆消去
Dim Keywrd As String
Dim TargetCell As Range
Keywrd = "a"
If Keywrd = "" Then Exit Sub
With Worksheets("a2元データ").Columns("A:A")
Set TargetCell = .Find(Keywrd, LookAt:=xlWhole, LookIn:=xlValues)
If TargetCell Is Nothing Then
MsgBox Keywrd & " は見つかりません。"
Exit Sub
End If
End With
TargetCell.EntireRow.Copy Worksheets("a2").Range("A387")
TargetCell.EntireRow.Delete Shift:=xlUp
'タイトル項目コピー(Keyword)
Sheets("a2元データ").Select
Rows("1:1").Select
Selection.Copy
Sheets("集計Sheet").Select
Rows("1:1").Select
ActiveSheet.Paste
以降、集計統合プログラムの記述が続き"End If"となります。