VBAの登録ボタン押下により、別シートへデータを登録していきたい

Question

前提・実現したいこと

VBAの登録ボタン押下により、入力データ（社員情報）を別シートにマスタデータとして次々に登録したいのですが、１レコードしか登録されません。
なぜ１レコードしか登録されないのかわからないため、アドバイスをいただけませんでしょうか。
ご教示の程、よろしくお願いいたします。

該当のソースコード

Sub Touroku_Click()

    Dim sht As Worksheet
    Set sht = Worksheets("社員マスタ")
    
    Dim LastRow As Integer
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row + 1
     
    'MsgBox LastRow
    
    If Range("E3").Value <> "" Then
        sht.Range("B" & LastRow) = Range("E3").Value
    End If
  
    If Range("J3").Value <> "" Then
        sht.Range("C" & LastRow) = Range("J3").Value
    End If
    
    If Range("E5").Value <> "" Then
        sht.Range("D" & LastRow) = Range("E5").Value
    End If
    
    If Range("E7").Value <> "" Then
        sht.Range("E" & LastRow) = Range("E7").Value
    End If
    
    If Range("J7").Value <> "" Then
        sht.Range("F" & LastRow) = Range("J7").Value
    End If
    
    If Range("M7").Value <> "" Then
        sht.Range("G" & LastRow) = Range("M7").Value
    End If
        
    'If Range("E9").Value <> "" And Range("E7").Value = "" Then
        'MsgBox "入社年月日を入力してください"
        
        If Range("E9").Value <> "" Then
            sht.Range("H" & LastRow) = Range("E9").Value
        End If
    'End If
    
    If Range("J9").Value <> "" Then
        sht.Range("I" & LastRow) = Range("J9").Value
    End If
    
    If Range("M9").Value <> "" Then
        sht.Range("J" & LastRow) = Range("M9").Value
    End If
    
    Select Case Range("BA11").Value
        Case 1
            sht.Range("K" & LastRow) = "未経験"
        Case 2
            sht.Range("K" & LastRow) = "１年未満"
        Case 3
            sht.Range("K" & LastRow) = "１年～３年"
        Case 4
            sht.Range("K" & LastRow) = "３年～５年"
        Case 5
            sht.Range("K" & LastRow) = "５年～１０年"
        Case 6
            sht.Range("K" & LastRow) = "１０年以上"
    End Select
    
    
    If Range("E13").Value <> "" Then
        sht.Range("L" & LastRow) = Range("E13").Value
    End If
    
    If Range("J13").Value <> "" Then
        sht.Range("M" & LastRow) = Range("J13").Value
    End If
    
    If Range("O13").Value <> "" Then
        sht.Range("N" & LastRow) = Range("O13").Value
    End If
    
    If Range("T13").Value <> "" Then
        sht.Range("O" & LastRow) = Range("T13").Value
    End If

End Sub

試したこと

最大行（LastRow）を定義してみました。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Answer 1

    Dim LastRow As Integer
    LastRow = Cells(Rows.Count, 2).End(xlUp).Row + 1

これだと、アクティブなシート(社員情報シートかな？)の最終行を取得してます。

ご希望ことは、「社員マスタ」シートの最終行に、社員データを転記したいということだと思いますので、下記のようにシートを指定しないとダメだと思います。

    Dim sht As Worksheet
    Set sht = Worksheets("社員マスタ")

    Dim LastRow As Integer
    LastRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row + 1

Comments

[shogakusha]

ありがとうございます。
無事に解決できました。