Thế nào thì gọi là kg đúng yêu cầu. Cái này đơn giản là đặt Filter rồi copy qua vùng khác là được mà ?
Thử .
Sub laydulieu()
Dim i As Long, lr As Long, arr, kq, a As Long
With Sheets("sheet1")
lr = .Range("A" & Rows.Count).End(xlUp).Row
If lr = 1 Then Exit Sub
arr = .Range("A2:D" & lr).Value
ReDim kq(1 To UBound(arr), 1 To 4)
For i = 1 To UBound(arr)
If Len(arr(i, 2)) > 0 Then
a = a + 1
kq(a, 1) = arr(i, 1)
kq(a, 2) = arr(i, 2)
kq(a, 3) = arr(i, 3)
kq(a, 4) = arr(i, 4)
End If
Next i
lr = .Range("A" & Rows.Count).End(xlUp).Row
If lr > 1 Then .Range("h2:K" & lr).ClearContents
If a Then .Range("H2:K2").Resize(a).Value = kq
End With
End SubVâng ạ. Tuy vậy nó cũng nảy sinh vấn đề là ẩn đi mất dòng.
Em đang cần cái này quá. Code tuyệt vời anh @snow25 ạ!
Copy --> Paste ra, tắt Filter đi không mất hay ẩn dòng gì cả.
Tôi nghĩ người ta đã kết giải pháp ở bài #3 rồi.
Quá đúng.
pate, tiếng xưa là cái mỏ ác, bạn ạ. Cái trát vào bánh mì là pâté.----
Sao lại có tiết mục bánh mì pate ở đây nhỉ.
'
Sub XoaHangCoOTrong()
[A1].CurrentRegion.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
end subSub ChepVaXoaHangCoOTrong()
Dim sH&
sH = [A1].CurrentRegion.Rows.Count
[A1].CurrentRegion.Copy [h1]
Range("I1:I" & sH).SpecialCells(xlCellTypeBlanks).Offset(, -1).Clear
Range("H1:K" & sH).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End Sub
