Excelの別ファイルへのセルコピー

=============================================================

Sub 追加機能()
'
' 追加機能 Macro
'
'ユーザ側でマージ先を指定
Dim OpenFileName As String
Dim readBook As Workbook ' 相手ブック
Dim readSheet As Worksheet ' 相手シート

' OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xlsx") ' ファイルを選択
' Set readBook = Workbooks.Open(OpenFileName) ' ファイルを開く
Set readBook = Workbooks.Open(ThisWorkbook.Path & "\Base.xlsx") ' ファイルを開く
Set readSheet = readBook.Worksheets("add1") ' シートのオブジェクトを取得

Windows(ThisWorkbook.Name).Activate ' 追加ファイルをアクティブ

Dim bf_Row As Integer '追加元ファイルの行
Dim bf_Colom As Integer '追加元ファイルの列
Dim af_Row As Integer
Dim af_Colom As Integer

Dim bf_cnt As Integer
Dim af_cnt As Integer
bf_Row = 3
bf_Colom = 4
af_Row = 3
af_Colom = 4

'追加元ファイルのheadからtail end(Blank cell)までループ
bf_cnt = 0
Do While Cells(bf_Row + bf_cnt, bf_Colom).Value <> ""
af_cnt = 0

'追加先ファイルをheadからtail end(Blank cell)までチェック
Do While readSheet.Cells(af_Row + af_cnt, af_Colom).Value <> ""

If Cells(bf_Row + bf_cnt, bf_Colom - 2).Value = "Common" Then
'Commmon Patten
If readSheet.Cells(af_Row + af_cnt, af_Colom).Value = Cells(bf_Row + bf_cnt, bf_Colom).Value Then
'チェック行のright 右２行をコピー
readSheet.Cells(af_Row + af_cnt, af_Colom + 1).Value = Cells(bf_Row + bf_cnt, bf_Colom + 1).Value
readSheet.Cells(af_Row + af_cnt, af_Colom + 2).Value = Cells(bf_Row + bf_cnt, bf_Colom + 2).Value
GoTo Label1
End If
End If

af_cnt = af_cnt + 1
Loop
Label1:
If Cells(bf_Row + bf_cnt, bf_Colom - 2).Value <> "Common" Then
readSheet.Cells(af_Row + af_cnt, af_Colom - 2).Value = Cells(bf_Row + bf_cnt, bf_Colom - 2).Value
readSheet.Cells(af_Row + af_cnt, af_Colom - 1).Value = Cells(bf_Row + bf_cnt, bf_Colom - 1).Value
readSheet.Cells(af_Row + af_cnt, af_Colom).Value = Cells(bf_Row + bf_cnt, bf_Colom).Value
readSheet.Cells(af_Row + af_cnt, af_Colom + 1).Value = Cells(bf_Row + bf_cnt, bf_Colom + 1).Value
readSheet.Cells(af_Row + af_cnt, af_Colom + 2).Value = Cells(bf_Row + bf_cnt, bf_Colom + 2).Value
End If

bf_cnt = bf_cnt + 1
Loop

End Sub