VBA: 入力シートから別シートに転記

ExcelVBAにおいて、入力シートに入力した内容を転記シートに反映させたいのですが、下記のケースの場合どのようにすればよいかご教示ください。

入力シートへ一通り入力したら、転記シート１行に転記。ということを繰り返します。

①　入力シートの受取人欄②は、入力する場合としない場合がありますが、最終行の１つ下に転記するという構文だと繰り返し入力すると記載行がずれてしまいます。どのようにすれば同じ行に転記されますでしょうか。

②　転記シートの受取人欄①には入力シートの2か所のセルを結合したい。
→　入力シートの D8 が中国もしくはベトナム　の場合、F8 とD10 を転記シートの受取人欄①に反映させる
D8が中国とベトナム以外の場合は、D10のみ転記シートの受取人欄①に反映させる。
F8はD8をプルダウンから選択することによって、文言が変わります。

大変恐縮ですが上記２つにつき教えてください。
どうぞよろしくお願いいたします

＜入力シート＞

＜転記シート＞

下記構文の場合、転記行がずれてしまう。またIF文が正しくないため、エラーになっております

Sub 起票シートに転記()
    Dim ws As Worksheet
    Set ws = Worksheets("起票")
    With Worksheets("入力シート")
        ws.Cells(Rows.Count, 2).End(xlUp).Offset(1) = .Range("D5")
        ws.Cells(Rows.Count, 4).End(xlUp).Offset(1) = .Range("D4")
        ws.Cells(Rows.Count, 5).End(xlUp).Offset(1) = .Range("D6")
        ws.Cells(Rows.Count, 6).End(xlUp).Offset(1) = .Range("D7")
        ws.Cells(Rows.Count, 7).End(xlUp).Offset(1) = if(range("D8")="中国"or"ベトナム" then
            Application.WorksheetFunction.Concat(.Range("F8"), Range("D10"))
         Else
            .Range ("D10")
         End If
        ws.Cells(Rows.Count, 8).End(xlUp).Offset(1) = .Range("D11")
        .Range("F9").Copy
        ws.Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        
        
        .PrintOut
        .Range("D4:D11") = ""
    End With
End Sub

行動規範の内容に同意します

回答1件

ベストアンサー

これでどうでしょうか。

VBA
1Sub 起票シートに転記()
2    Dim ws As Worksheet
3    Set ws = Worksheets("起票")
4    With Worksheets("入力シート")
5        Dim r
6        r = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1
7        ws.Cells(r, 2) = .Range("D5")
8        ws.Cells(r, 4) = .Range("D4")
9        ws.Cells(r, 5) = .Range("D6")
10        ws.Cells(r, 6) = .Range("D7")
11        ws.Cells(r, 7) = IIf(.Range("D8") = "中国" Or .Range("D8") = "ベトナム", .Range("F8") & Range("D10"), .Range("D10"))
12        ws.Cells(r, 8) = .Range("D11")
13        ws.Cells(r, 9) = .Range("F9")
14        
15        .PrintOut
16        .Range("D4:D11") = ""
17    End With
18End Sub
19