Sửa dùm code trích dử liệu (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

thanhtratt

Thành viên hoạt động
Tham gia
14/7/09
Bài viết
136
Được thích
167
Giới tính
Nam
Nghề nghiệp
Search
Yêu cầu của mình cũng tương tự như file đính kèm nhưng hơi khác 1 chút, khổ nổi mình không biết về VBA đên đành phải nhờ các Cao thủ GPE sửa lại giúp. Mình cám ơn rất nhiều.
Mình đã nêu cụ thể trong file.
 

File đính kèm

Lần chỉnh sửa cuối:
Hoàn chỉnh 2 vấn đề cho bạn đây, xin mời

PHP:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("F5:F65536")) Is Nothing Then
   Dim Rng As Range, sRng As Range:       Dim Sh As Worksheet
   
   Set Sh = Sheets("BKL")
   Set Rng = Sh.Range(Sh.[b6], Sh.[b65500].End(xlUp))
   If UCase$(Target.Value) = "X" Then  'Chép'
      Set sRng = Rng.Find(Target.Offset(, -5).Value, , xlFormulas, xlWhole)
      If sRng Is Nothing Then
         With Sh.[b65500].End(xlUp).Offset(1)
            .Resize(, 3).Value = Target.Offset(, -5).Resize(, 3).Value
            .Offset(, 4).Resize(, 2).Value = Target.Offset(, -2).Resize(, 2).Value
         End With
      Else
         MsgBox "Da Có Ròi!", , "GPE.COM"
      End If
   ElseIf Target.Value = "" Then  'Xóa'
      Set sRng = Rng.Find(Target.Offset(, -5).Value, , xlFormulas, xlWhole)
      If sRng Is Nothing Then
         MsgBox "Da Xóa Ròi!", , "GPE.COM"
      Else
         sRng.EntireRow.Delete
      End If
   End If
End If
End Sub
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom