こんにちは。
質問を読ませていただいた感じでは、「あとから入社した人を先にいる人の次の行」に入れるのであって、それは、Excelの「並べ替え」の範囲とは、違ったものだと解釈しました。
それも、営業部ではなくて、営業部＋営業支援という並びで探さなくてはならないわけだと思います。Findメソッドで、2重検索は、補助列を作らない限りは、出来そうにもありません。後は、可能性としてはAdvnacedFilterぐらいかと思います。
そこで、以下を考えてみました。
ただし、一つだけ、このマクロには条件があります。それは、少なくとも、部・課自体は並べ替えが済んでいて、点在して存在していないことです。
以下のマクロをサブルーチンにして、検索行を引数に取るようにすれば、検索行は、複数あっても可能だと思います。
検索行を以下に設定します。
F2～
F G H
営業部 営業支援 小野伸二
とシートに書き込んでください。
ユーザー設定は、以下の二つです。
Set kensaku = Range("F2")
Set r = Range("A2", Range("A2").End(xlDown))
以下は、シートモジュールか、標準モジュールにしてください。
なお、このマクロは、同じものを二重に登録する可能性を考慮していません。
Option Explicit
Sub Sample1()
Dim r As Range, Kensaku As Range, rc As Long, i As Long
Dim num As Variant, k As Long
Dim ar() As Variant
'データの左端 (要ユーザー設定）
Set r = Range("A2", Range("A2").End(xlDown))
rc = r(r.Count).Row '最終行
'検索行の左端セル(要ユーザー設定）
Set Kensaku = Range("F2")
If IsEmpty(Kensaku) Then _
MsgBox "検索値がありません。", vbCritical: Exit Sub
k = 1
For i = r.Rows.Count To 1 Step -1
'2つの列を配列に逆さまに入れる
ReDim Preserve ar(1 To k)
ar(k) = r.Cells(i, 1).Value & r.Offset(, 1).Cells(i, 1).Value
k = k + 1
Next i
'Match 関数を使って調べる
num = Application.Match(Kensaku.Value & Kensaku.Offset(, 1).Value, _
ar, 0)
If Not IsError(num) Then
Rows(rc - num + 2).Insert
Rows(rc - num + 2).Resize(, 3).Value = Kensaku.Resize(, 3).Value
Kensaku.Resize(, 3).ClearContents
Else
If MsgBox("該当する部・課が見つかりません。" & _
"最後尾にデータを貼り付けますか", 32 + vbOKCancel) = vbOK Then
Rows(rc + 1).Resize(, 3).Value = Kensaku.Resize(, 3).Value
Kensaku.Resize(, 3).ClearContents
End If
End If
Set r = Nothing: Set Kensaku = Nothing
End Sub
