Kết hợp VBA và Sao chép và Dán

Tôi tự hỏi liệu ai đó có thể giúp tôi được không.

Tôi đang sử dụng mã dưới đây để tự động xác định một số cột có văn bản được xác định trước khi giá trị được nhập vào cột "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

Điều này hoạt động tốt, nhưng bây giờ tôi muốn mở rộng chức năng này thêm một chút. Tôi cũng muốn dân số cột xảy ra nếu các giá trị được sao chép và dán vào cột "B" ngoài khi chúng được nhập thủ công.

Điều này sẽ giúp ích khi tôi di chuyển thông tin từ các trang hiện có sang trang mới tôi đang xây dựng. Mặc dù đây là thay đổi cuối cùng tôi cần thực hiện, nhưng nó chứng tỏ là khó nhất để tìm giải pháp cho.

Tôi chỉ tự hỏi liệu ai đó có thể nhìn vào điều này xin vui lòng và đưa ra một số hướng dẫn về cách tôi có thể đạt được điều này.

Rất cám ơn và trân trọng

Chris

Theo Karen, sự kiện này sẽ kích hoạt nếu nội dung bị cắt và dán. Vấn đề là, mã bạn đã đăng sẽ kiểm tra xem số lượng ô được trả về có lớn hơn một không và nếu có, nó sẽ ngăn sự kiện thực thi:

If Target.Cells.Count > 1 Then Exit Sub

Thay đổi mã này, và nó sẽ hoạt động tốt.

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

Điều đã được thực hiện ở đây là dòng mã đã bị xóa để cho phép sự kiện phát sinh ngay cả khi có nhiều ô nằm trong phạm vi mục tiêu và sau đó chúng tôi sử dụng vòng lặp For Each trên các ô có trong Target để hoạt động trên mỗi hàng.

Nim

Các Worksheet_Change (ByVal Target As Range) sự kiện bị sa thải bởi cả hai nhập thủ công và dán dữ liệu, vì vậy nó chỉ nên hoạt động. Bạn đã thử à?