マッチング

Excel　VBA
'-------------------------------------------------
'2つの表が開いた状態で、他方シートを検索し
'マッチした場合、転機するマクロ
'-------------------------------------------------

Option Explicit

Public OpenFile0 As Workbook 'Thisworkbookオブジェクト
Public OpenFile1 As Workbook '転機元bookオブジェクト
Public OpenFile2 As Workbook '転機先bookオブジェクト

Public OPF0SH1 As Worksheet 'Thisworkbook_worksheet1
Public OPF1SH1 As Worksheet 'book1worksheet
Public OPF2SH1 As Worksheet 'book2worksheet

Public Const CONOpenFile1 As String = "転機元.xlsx"
Public Const CONOpenFile2 As String = "転機先.xlsx"

Public Const CONComparison1 As Long = 2 '比較元列番号
Public Const CONComparison1 As Long = 5 '比較先列番号

Public Const CONTurningCol1 As Long = 5 '転機元列番号
Public Const CONTurningCol2 As Long = 6 '転機先列番号

Public Const CONTStartrow As Long = 2 '比較元開始列行番号

Sub Matching()
Dim OPF1startMaxRow As Long '比較元列最下行
Dim kanriNo As String '検索する文字列
Dim i As Long
Dim FoundCellRow As Long '検索された行番号

Set OpenFile0 = ThisWorkbook
Set OPF0SH1 = OpenFile0.Worksheets(1)

Set OpenFile1 = Workbooks(CONOpenFile1)
Set OPF1SH1 = OpenFile1.Worksheets(1)

Set OpenFile2 = Workbooks(CONOpenFile2)
Set OPF2SH1 = OpenFile2.Worksheets(1)

OPF1startMaxRow = OpenFile1.OPF1SH1.Cells(Rows.Count, CONComparison1).End(xlUp).Row '最下行
'kanriNo = Cells(OPF1startMaxRow, CONComparison1).Value '最後に登録された管理番号

OPF2SH1.Activate

'転機
For i = CONTStartrow To OPF1startMaxRow
kanriNo = OpenFile1.OPF1SH1.Cells(i, CONComparison1).Value

'検索
Set FoundCell = Columns(CONComparison1).Find(What:=kanriNo)
If FoundCell Is Nothing Then
'MsgBox kanriNo & "検索文字列が見つかりませんでした。"
Else
FoundCellRow = FoundCell.Row
OPF2SH1.OPF2SH1.Cells(FoundCellRow, CONTurningCol2) = OpenFile1.OPF1SH1.Cells(i, CONTurningCol1).Value

End If

Next i

End Sub