VBA 一覧からデータを抽出し、帳票を作成する

以前も質問させていただきましたが、あまりにも丸投げだったため、たくさんご指摘をいただきましたので、
自分なりに本やネットを参考に下記マクロを作成しましたが、どうしてもわからない部分があったので再度ご質問させていだきます。


【やりたいこと】
　昇格者データ・昇格者マスタのシートから必要情報を拾い、FBひな形を作成し、昇格者ごとにエクセルとPDFファイルを作成し、保存したい。
　（実際の昇格者対象者は300名ほどいます）

【教えていただきたいこと】
　添付画像のとおり、３つのシートを用いて帳票を作成したいと思います。
「昇格者データのA列とB列の値が等しければ一つのグループである」と範囲指定まではできていますが、その範囲指定した中から
下記条件をみたす値を拾いたいときの構文の書き方を教えていただきたいです。
　　1、昇格者データのF列に｢キーマン｣とある人のG～Q列をFBひな形の8～19行目に入れたい
　　2、昇格者データのR列の値をFBひな形のコメント①(C23,C29,C35)、S列の値をFBひな形のコメント②(C42,C48,C54)へ入れたい。


【前提条件】
　①3つのシートは一つのブックにまとまっています。
　②昇格者１人につき、評価者が３名います。

見よう見まねで範囲指定を行い、その中から条件抽出すればできるかなと思ったのですが、いかがでしょうか？
素人が作成したマクロで、不必要な部分ももしかするとあるかもしれませんが、併せて
ご教授いただければと思います。よろしくお願いいたします。

以下、作成したマクロです。
--------------------------------------------------------------------------------------------------------
Sub 評価FB作成()

Dim wsData As Worksheet '「昇格者データ」シート
Set wsData = ThisWorkbook.Worksheets("昇格者データ")

Dim rngAccount As Range '「昇格者マスタ」検索範囲
Set rngAccount = ThisWorkbook.Worksheets("昇格者マスタ").Range("A:D")

Call wsDataSort

Dim startRow As Long 'コピー範囲の最初の行と最終行を格納
startRow = 2

Dim wsTemplate As Worksheet '「FBひな形」シート
Dim strFile As String '保存先フォルダパス＆ファイル名（拡張子抜き）

Dim strAccount As String '昇格者名

Dim i As Long '昇格者マスタの範囲を指定する
i = 2
Do While wsData.Cells(i, 1).Value <> ""

i = i + 1
If wsData.Cells(i, 1).Value <> wsData.Cells(startRow, 1).Value Or wsData.Cells(i, 2).Value <> wsData.Cells(startRow, 2).Value Then

'*****新規ワークブックを作成*****
Workbooks.Add '新規ワークブックを作成
ThisWorkbook.Worksheets("FBひな形").Copy before:=ActiveWorkbook.Sheets(1) '新規ワークブックのsheet1の前にひな形をコピー

Set wsTemplate = ActiveSheet 'コピーしたシートを変数にセット
wsTemplate.Name = "フィードバック" 'シート名を変更

Application.DisplayAlerts = False '確認メッセージをオフにする
ActiveWorkbook.Worksheets("Sheet1").Delete 'Sheet1を削除する
Application.DisplayAlerts = True '確認メッセージをオンにする

strFile = ThisWorkbook.Path & "\" & Format(wsData.Cells(startRow, 1).Value & wsData.Cells(startRow, 2).Value)

'*****PDF出力設定*****
With wsTemplate.PageSetup

.Zoom = False '倍率をクリア
.FitToPagesWide = 1 '横方向に1ページに収める
.FitToPagesTall = 1 '縦方向に1ページに収める
.CenterHorizontally = True '水平方向に中央配置
.TopMargin = Application.CentimetersToPoints(1) '上マージンを1cm
.BottomMargin = Application.CentimetersToPoints(1) '下マージンを1cm

End With

'*****フィードバックの各データを入力*****
wsTemplate.Range("C29").Value = wsDate.Cells(startRow, 18).Value
On Error Resume Next 'エラーを無視

strAccount = wsData.Cells(startRow, 1).Value '昇格者CD
wsTemplate.Range("B4").Value = strAccount '昇格者CD
wsTemplate.Range("D4").Value = WorksheetFunction.VLookup(strAccount, rngAccount, 2, False) '昇格者氏名
wsTemplate.Range("H4").Value = WorksheetFunction.VLookup(strAccount, rngAccount, 3, False) '所属
wsTemplate.Range("L4").Value = WorksheetFunction.VLookup(strAccount, rngAccount, 4, False) '目標資格

If Err.Number <> 0 Then 'エラーが発生したときにメッセージを表示
MsgBox strAccount & "の情報を取得するVlookupでエラーが発生しました"
Err.Clear 'Errオブジェクトをクリア
End If

'*****PDF出力をして保存して閉じる*****
wsTemplate.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf" '選択したシートをPDF出力
ActiveWorkbook.Close savechanges:=True, Filename:=strFile & ".xlsx" 'アクティブブックを名前を付けて保存して閉じる

startRow = i

End If

Loop

End Sub



Sub wsDataSort()

With ActiveWorkbook.Worksheets("昇格者データ")

'昇格者データをA列氏名CD、B名前で並び替え（見出しは範囲に含めない）
.Range("A1").CurrentRegion.Sort Key1:=.Range("B2"), Key2:=.Range("A2"), Header:=xlYes

End With

End Sub

No.4 回答者： Qchan1962 回答日時： 2019/11/16 17:53

＃3です。

訂正します。デバッグしてないので許してください。
strAccount = wsData.Cells(startRow, 1).Value　　'昇格者CD
は
strAccount = .Cells(startRow, 1).Value　　'昇格者CD
でOK
　　　　　　Range("C" & 23 + ix).Value = Keycomment(ai, 0)
　　　　　　Range("C" & 42 + ix).Value = Keycomment(ai, 1)
は
　　　　　　.Range("C" & 23 + ix).Value = Keycomment(ai, 0)
　　　　　　.Range("C" & 42 + ix).Value = Keycomment(ai, 1)
でお願いします。

No.3 回答者： Qchan1962 回答日時： 2019/11/16 17:39

＃１の方の言う通りよくわからず検証していません。

ちなみにPDF系はPDF系でまとめられたほうが良いです。見にくいです。
PDF部分がなかったらもっと早く読み込んだのだけれど、、、暇だったので読んでみました。

記載のコードなどは評価していません。動くものと考え
ご質問の列やコード内容から判断して

'*****フィードバックの各データを入力*****以下
'*****PDF出力をして保存して閉じる*****までを書き換えてみました。

'*****PDF出力設定*****の上に書いた方が良いかと、、思います。

　　'*****フィードバックの各データを入力*****
新たに必要な変数を加えました。変数型は、宣言していないのでVariantになりますが
自動で上からString　LongまたはInteger　配列はVariantまたはStringになるかと、、
基本気にしなくてOKです。

On Error Resume Next　　'エラーを無視
Dim 昇格者氏名, 所属, 目標資格
Dim ix, ai, maxRow
Dim Keycomment(2, 1)
　　With wsData
　　　　maxRow = .Cells(Rows.Count, 1).End(xlUp).Row
　　　　strAccount = wsData.Cells(startRow, 1).Value　　'昇格者CD
　　　　昇格者氏名 = WorksheetFunction.VLookup(strAccount, rngAccount, 2, False)
　　　　所属 = WorksheetFunction.VLookup(strAccount, rngAccount, 3, False)
　　　　目標資格 = WorksheetFunction.VLookup(strAccount, rngAccount, 4, False)
　　　　ai = 0
　　　　For ix = 2 To maxRow
　　　　　　If Range("F" & ix) = "キーマン" Then
　　　　　　　　Keycomment(ai, 0) = Range("R" & ix).Value
　　　　　　　　Keycomment(ai, 1) = Range("S" & ix).Value
　　　　　　　　ai = ai + 1
　　　　　　End If
　　　　　　If ai = 3 Then Exit For
　　　　Next
　　End With
　　With wsTemplate
　　　　.Range("B4").Value = strAccount　　'昇格者CD
　　　　.Range("D4").Value = 昇格者氏名
　　　　.Range("H4").Value = 所属
　　　　.Range("L4").Value = 目標資格
　　　　ai = 0
　　　　For ix = 0 To 12 Step 6
　　　　　　Range("C" & 23 + ix).Value = Keycomment(ai, 0)
　　　　　　Range("C" & 42 + ix).Value = Keycomment(ai, 1)
　　　　　　ai = ai + 1
　　　　　　If ai = 3 Then Exit For
　　　　Next
　　　　Erase Keycomment
　　End With
　　If Err.Number <> 0 Then　　'エラーが発生したときにメッセージを表示
　　　　MsgBox strAccount & "のフィードバック情報作成でエラーが発生しました"
　　　　Err.Clear　　'Errオブジェクトをクリア
　　End If

抽出と書き込みがシート別で分けれるのでWithで括ってみました。
重ねて申し上げますが、検証環境などを作成できないので未検証です。
結果を知らせて頂ければ幸いです。

No.2 回答者： GooUserラック 回答日時： 2019/11/16 16:51

「FBひな形」シートが特に見えないので、「FBひな形」だけでも良いので再掲載いただけないでしょうか？

No.1 回答者： めぐみん_ 回答日時： 2019/11/13 08:23

回答ではなくちょっとした疑問ですが、質問者さんの方ではこの画像判読できます？

３つシートが存在しているのは何となくわかりますが、それぞれがどうつながるのか、やりたい事と３つのシート（左側は多分書き出したい書式には思うけど）の
関係性が今一つ視覚確認出来ないかなって感じます。
何も３つを１つにして小さな画像にしなくても、３つを別々に載せた方がまだわかりやすかったのではないでしょうか？