一致した場合の転記

Sub CopyTo37()
    Dim ws As Worksheet
    Dim rng28to35 As Range
    Dim rng37 As Range
    Dim セル As Range
    Dim カウント As Integer
    
    ' 対象のワークシートを指定
    Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更
    
    ' L列の28行目から35行目の範囲を取得
    Set rng28to35 = ws.Range("L28:L35")
    
    ' 28行目から35行目の範囲に何も入っていない場合は処理を終了
    If WorksheetFunction.CountA(rng28to35) = 0 Then
        Exit Sub
    End If
    
    ' 37行目のセルを取得
    Set rng37 = ws.Range("L37")
    
    ' 28行目から35行目の範囲をループ処理
    For Each セル In rng28to35
        ' セルに値が入っている場合
        If セル.Value <> "" Then
            カウント = カウント + 1 ' セルの値が入っている数をカウント
            
            ' セルの値を37行目にコピー
            If カウント = 1 Then
                rng37.Value = セル.Value
            ' 2行以上のセルに値が入っている場合はエラーメッセージを表示
            Else
                rng37.Value = "それはエラーです"
            End If
        End If
    Next セル
End Sub