空白セルを検索してその隣列から貼り付けしたい

Question

以下の”組織図”シートから”Sheet1”シートにコピペするマクロなのですが、
うまくいきません。
”組織図”　例）
営業課　　　　　メンバー）山田花子
課長)田中太郎

”Sheet1”シートのA列に課を、
B列に一つ下のセルの課長を、
C列に一つ右のセルのメンバーを貼り付けたいのですが、
以下の書き方ですと、C列の同じ空白セルに何度も貼り付けしてしまいます。
どうしたらよいでしょうか。

Sub メンバー検索()

Dim SearchRange As Range '検索範囲格納
Dim ResultRange As Range '検索結果格納
Dim StartRange  As Range '検索行格納
Dim KeyItem     As String
Dim MsgStr      As String


Set SearchRange = Worksheets("組織図").Range("A:Z")   '検索したいデータ範囲

KeyItem = "課"

Set ResultRange = SearchRange.Find(KeyItem, LookAt:=xlPart)

If Not ResultRange Is Nothing Then
    Set StartRange = ResultRange.Offset(0, 1) '最初に見つかったセルを格納しておく


Do
          If InStr(ResultRange.Value, "課長") = 0 And InStr(ResultRange.Value, "課担当") = 0 Then
     ResultRange.Offset(0, 1).Copy
       Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).PasteSpecial (xlPasteValues)
     
     Application.CutCopyMode = False
    
    
   
    
    End If
 
      Set ResultRange = SearchRange.FindNext(After:=ResultRange) '次の検索セルを指定する
      
    
    
     If ResultRange.Offset(0, 1).Address = StartRange.Address Then '見つかったセルが最初のセルか判定
    
        Exit Do '同じ場合はループを離脱
        
    
    End If
    

Loop

End If

End Sub

Answer 1

ごめんなさい質問文とソースを何十回読み直しても何がしたいか理解できませんでした。
「A列に課をコピーする」処理と「B列に課長をコピーする」処理はどこ行ったんですかね・・・
無理やり解釈するならこういう事をやろうとしている？

Dim i As long

Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Offset(1 + i, 1).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

i = i + 1

Answer 2

こんな感じでどうでしょうか。（修正しました）

Dim ka, kacho, member
ka = ResultRange.Value
kacho = ResultRange.Offset(1, 0).Value
member = ResultRange.Offset(0, 1).Value
Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(1, 3).Value = Array(ka, kacho, member)

（修正前）

Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Offset(1).PasteSpecial xlPasteValues

Comments

[GKHHKJ]

頂いたとおりに書くとC列の1行目から貼り付けられてしまいました(´;ω;｀)