Excelで2つの列を1つの列に合わせたい

　
関数の式をエクセルファイルで作成しましたので、
　
次のＵＲＬからダウンロードしてください。

http://firestorage.jp/download/83c2c76af1d2c84fb7b3efdf10615849e6b35688
　
Ｈ列をコピーしてＩ列に値貼り付けすればご希望のデータが出来上がります。
　
よろしくお願いします。
　

１）フィルタでI列の空白だけを抽出
２）空白セルに関数を入れる
３）フィルタで抽出された空白セル全てにコピペ

おまけ）関数のままで問題ならばそこで値の貼り付けでコピペ


フィルタで隠れている部分はコピペの対象外なので、元のI列データは維持したまま出来るかと。

私の思うところが伝わっていなかったようなので。

「sTarget」に処理対象文字列（今回の例であれば「りんご」）を指定して実行して下さい。

Public Sub transferJ2I(ByVal sTarget As String)

    Const TARGET_SHEET_NAME As String = "Sheet1"

    '移動元列（J）
    Const SOURCE_COL    As Long = 10

    '移動先列（I）
    Const DEST_COL      As Long = 9

    Dim lHeaderRow      As Long
    Dim xlFilterRow     As Range
    Dim lTargetCounts   As Long
    Dim lTargetRows()   As Long
    Dim lCount          As Long
    Dim i               As Long

    With ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
        'オートフィルタの設定状態
        If .AutoFilterMode = True Then
            'オートフィルタが設定済みなら、一旦解除
            .AutoFilter.Range.AutoFilter
        End If

        'オートフィルタのヘッダとなる行を取得
        If .Cells(1, SOURCE_COL).Value <> "" Then
            lHeaderRow = 1
        Else
            lHeaderRow = .Cells(1, SOURCE_COL).End(xlDown).Row
        End If

        '指定文字データを抽出
        With .Range(.Cells(1, SOURCE_COL), .Cells(.Rows.Count, SOURCE_COL))
            'オートフィルタ実行
            .AutoFilter Field:=1, Criteria1:=sTarget

            '絞り込まれた件数取得（ヘッダー行までの行が含まれているので、その分を補正）
            lTargetCounts = .CurrentRegion.Resize(, 1).SpecialCells(xlVisible).Count - lHeaderRow

            If lTargetCounts > 0 Then
                '対象の行を格納する配列初期化
                ReDim lTargetRows(lTargetCounts - 1)

                For Each xlFilterRow In .CurrentRegion.Resize(, 1).SpecialCells(xlVisible)
                    '対象データの行の取得
                    If xlFilterRow.Row > lHeaderRow Then
                        'ヘッダー行以降
                        lTargetRows(lCount) = xlFilterRow.Row

                        lCount = lCount + 1
                    End If
                Next xlFilterRow
            End If
        End With

        'オートフィルタ解除
        .AutoFilter.Range.AutoFilter

        If .Cells(lHeaderRow, SOURCE_COL).Value = sTarget Then
            ReDim Preserve lTargetRows(lCount)

            lTargetRows(lCount) = lHeaderRow

            lTargetCounts = lTargetCounts + 1
        End If

        'データの移動
        For i = 0 To lTargetCounts - 1
            .Cells(lTargetRows(i), SOURCE_COL).Cut Destination:=.Cells(lTargetRows(i), DEST_COL)
        Next i
    End With

    Debug.Print "Done."

End Sub