VBAの組み込みとコピーと貼り付け

誰かが私を助けてくれるのではないかと思います。

以下のコードを使用して、値が列「B」に入力されたときに、事前定義されたテキストでいくつかの列に自動入力します。

Option Explicit
Public preValue As Variant


    Private Sub Worksheet_Change(ByVal Target As Range)

        Dim cell As Range, res As Variant
        Dim FirstBlankCell As Range
        Dim lr As Long
        Dim msg
        Dim rCell As Range
        Dim Rng As Range, Dn As Range
        Dim Rng1 As Range
        Dim Rng2 As Range
        Dim Rng3 As Range
        Dim Rng4 As Range
        Dim Rw As Range


        If Target.Cells.Count > 1 Then Exit Sub

        lr = lr


        With Target
            Select Case True

            Case .Column = 2
            If .Value2 > 0 And .Value2 <> "Enter your name" And .Offset(, -1) = "" Then
                    .Offset(, 1).Value2 = "Yes"
                    .Offset(, 2).Value2 = "--Select--"
                    .Offset(, 3).Value2 = "--Select--"
                    .Offset(, 4).Value2 = "--Select--"
                    .Offset(, 5).Value2 = "Enter your FTE"
                    .Offset(, 6).Value2 = "C&R"
                    .Offset(, 7).Value2 = "--Select--"
                    .Offset(, 17).Value2 = "Enter the name of your Line Manager"
                  End If
            Case Else
            End Select
        End With

    End Sub

これは正常に機能しますが、この機能をもう少し拡張したいと思います。また、値が手動で入力されたときだけでなく、値がコピーされて列「B」に貼り付けられた場合にも、列の挿入が発生するようにします。

これは、既存のシートから作成中の新しいシートに情報を移行するときに役立ちます。これは私が行う必要がある最後の変更ですが、解決策を見つけるのが最も難しいことを証明しています。

誰かがこれを見て、これを達成する方法についてのガイダンスを提供できるかどうか疑問に思いました。

多くの感謝と親切な敬意

クリス

カレンによると、コンテンツがカットアンドペーストされると、イベントが発生します。投稿したコードは、返されたセルの数が1より大きいかどうかを確認し、そうであれば、イベントの実行を停止します。

If Target.Cells.Count > 1 Then Exit Sub

コードをこれに変更すると、問題なく動作するはずです。

Dim cell As Range, res As Variant
Dim FirstBlankCell As Range
Dim lr As Long
Dim msg
Dim rCell As Range
Dim Rng As Range, Dn As Range
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim Rng4 As Range
Dim Rw As Range

lr = lr

Dim r As Range
For Each r In Target.Cells
With r
    Select Case True

    Case .Column = 2
    If .Value2 > 0 And .Value2 <> "Enter your name" And .Offset(, -1) = "" Then
            .Offset(, 1).Value2 = "Yes"
            .Offset(, 2).Value2 = "--Select--"
            .Offset(, 3).Value2 = "--Select--"
            .Offset(, 4).Value2 = "--Select--"
            .Offset(, 5).Value2 = "Enter your FTE"
            .Offset(, 6).Value2 = "C&R"
            .Offset(, 7).Value2 = "--Select--"
            .Offset(, 17).Value2 = "Enter the name of your Line Manager"
          End If
    Case Else
        End Select
    End With
Next r

ここで行われたのは、ターゲット範囲内にあるセルがさらにある場合でもイベントを起動できるようにコードの行が削除されたことです。そして、ターゲットに含まれるセルでFor Eachループを使用して各行で動作します。

ニム

Worksheet_Change（ByValの対象を範囲）イベントがで解雇された両方のデータを手動で入力して貼り付けるので、それだけで動作するはずです。やってみた？