【EXCEL VBA（マクロ）】縦（行）ループして、シート内を特定ワードで検索して一致させる

ワードで検索して一致するものを転記

これは、Excelワークブック内のアクティブシートを特定のワードで検索して、ワードが見つかった場合、アクティブシートの左に新規シートを追加して、そのシートにコピーして貼り付けるエクセルマクロです。

Sub シート間_語句を含むものを検索()

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
End With

'基_アクティブシート
Dim wb1 As Workbook
Set wb1 = ThisWorkbook
Dim ws1 As Worksheet
Set ws1 = wb1.ActiveSheet
Dim LastRow1 As Long
LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Dim a As Long

'転記先_アクティブシートの左のシート
Dim ws2 As Worksheet
Dim sheetName As String
sheetName = ActiveSheet.Name & "_作成" & VBA.Format(Now(), "h時mm分ss秒")

'同名のシートが存在する場合は削除
On Error Resume Next
Set ws2 = wb1.Worksheets(sheetName)
If Not ws2 Is Nothing Then
    Application.DisplayAlerts = False
    ws2.Delete
    Application.DisplayAlerts = True
End If
On Error GoTo 0

Set ws2 = wb1.Worksheets.Add(before:=ActiveSheet)
ws2.Name = sheetName

b = 1 'B列の追加する行を指定します。

For a = 2 To LastRow1
        
    If InStr(ws1.Cells(a, 1), "a020") > 0 Then
        ws2.Cells(b, 1) = ws1.Cells(a, 1)
        b = b + 1
    End If
        
Next

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
End With

MsgBox "完了"

End Sub

解説

With Application … End With：Excelアプリケーションの画面更新を停止し、他のイベントやアラートを無効化して、マクロの実行速度を高めます。
基_アクティブシート：ThisWorkbook.ActiveSheetは、ワークブック内のアクティブなシートを参照します。ここでは、基本となるシートをwb1とws1に代入しています。また、基本となるシートの最後の行を取得しています。
転記先_アクティブシートの左のシート：現在のシートの左側に新しいシートを作成することを意味します。新しいシートの名前は、現在のシートの名前と現在の時間に基づいて作成され、重複する名前がある場合は、既存のシートを削除します。
For a = 2 To LastRow1：基本となるシートの2行目から最後の行まで、各行を順番に処理します。
If InStr(ws1.Cells(a, 1), “a020”) > 0 Then：現在の行の1列目の文字列に、指定の文字列 “a020” が含まれる場合に、以下の処理を実行します。
ws2.Cells(b, 1) = ws1.Cells(a, 1)：新しいシートに、現在の行の1列目の値をコピーします。
b = b + 1：新しいシートの次の行にコピーするために、bの値を1増やします。
With Application … End With：Excelアプリケーションの画面更新を再開し、他のイベントやアラートを有効化します。
MsgBox “完了”：処理が終了したことを示すメッセージを表示します。