Giúp code copy bỏ qua các dòng trống và dán

[LienDong]

Chào các bạn
Các bạn giúp mình, copy bỏ các dòng trống rồi dán qua sheet khác
Việc này thao tác tay thì nhanh, nhưng tôi muốn có code để ghép thêm các code khác
Cảm ơn các bạn.
Nói thêm, các dòng trống chỉ tính từ cột A đến cột E, các cột khác có thể có số liệu

 

[Nhattanktnn]

Chào các bạn
Các bạn giúp mình, copy bỏ các dòng trống rồi dán qua sheet khác
Việc này thao tác tay thì nhanh, nhưng tôi muốn có code để ghép thêm các code khác
Cảm ơn các bạn.

Hôm qua mình có giúp một bạn có vấn đề gần tương tự, từ danh sách có sẵn chỉ định một số cột (màu vàng), nếu có một ô trống là tách dữ liệu riêng ra sheet khác.
Bạn xem rồi sửa code cho phù hợp file của bạn nhé, cách sửa không khó

 

[LienDong]

Hôm qua mình có giúp một bạn có vấn đề gần tương tự, từ danh sách có sẵn chỉ định một số cột (màu vàng), nếu có một ô trống là tách dữ liệu riêng ra sheet khác.
Bạn xem rồi sửa code cho phù hợp file của bạn nhé, cách sửa không khó

Bạn hiểu sai ý mình, ý mình copy sheet Tonghop rồi dán qua sheet danh sách nhưng bỏ các dòng trống

 

[HUONGHCKT]

Chào các bạn
Các bạn giúp mình, copy bỏ các dòng trống rồi dán qua sheet khác
Việc này thao tác tay thì nhanh, nhưng tôi muốn có code để ghép thêm các code khác
Cảm ơn các bạn.
Nói thêm, các dòng trống chỉ tính từ cột A đến cột E, các cột khác có thể có số liệu

Trong khi chờ các giải pháp khác, hãy thử với code củ chuối sau, hy vọng đúng ý.

Option Explicit

Sub Macro1()
Dim Lrow&, iRow&
Dim Sh As Worksheet, Ws As Worksheet
'Dim Rng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Sh = Sheets("Tonghop")
Set Ws = Sheets("danhsach")
Lrow = Sh.Cells(Rows.Count, "A").End(xlUp).Row
If Lrow <= 8 Then
    MsgBox " Không có dư liêu"
    Exit Sub
Else
'Set Rng = Sh.Range("$A$9:E" & Lrow)
iRow = Ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
    Sh.Range("A8").Select
    Selection.AutoFilter
    
'    Rng.AutoFilter Field:=1, Criteria1:="<>"
'    Rng.Copy Ws.Range("B" & iRow)

    Sh.Range("$A$8:E" & Lrow).AutoFilter Field:=1, Criteria1:="<>"
    Sh.Range("A9:E" & Lrow).Copy Ws.Range("B" & iRow)
End If
Set Rng = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox " Done"
End Sub

 

[LienDong]

Trong khi chờ các giải pháp khác, hãy thử với code củ chuối sau, hy vọng đúng ý.

Option Explicit

Sub Macro1()
Dim Lrow&, iRow&
Dim Sh As Worksheet, Ws As Worksheet
'Dim Rng As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Sh = Sheets("Tonghop")
Set Ws = Sheets("danhsach")
Lrow = Sh.Cells(Rows.Count, "A").End(xlUp).Row
If Lrow <= 8 Then
    MsgBox " Không có dư liêu"
    Exit Sub
Else
'Set Rng = Sh.Range("$A$9:E" & Lrow)
iRow = Ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
    Sh.Range("A8").Select
    Selection.AutoFilter
   
'    Rng.AutoFilter Field:=1, Criteria1:="<>"
'    Rng.Copy Ws.Range("B" & iRow)

    Sh.Range("$A$8:E" & Lrow).AutoFilter Field:=1, Criteria1:="<>"
    Sh.Range("A9:E" & Lrow).Copy Ws.Range("B" & iRow)
End If
Set Rng = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox " Done"
End Sub

Nó bị báo lỗi 1004 dòng Sh.Range("A8").Select
Các bạn xem lại giúp, xin cảm ơn!

 

[HUONGHCKT]

Nó bị báo lỗi 1004 dòng Sh.Range("A8").Select
Các bạn xem lại giúp, xin cảm ơn!

Bạn phải để con chỏ ở sheet Tonghop, và chạy code trong file đính kèm thử xem.
Lưu ý: mỗi lần nhấn nút chay code là một lần copy sheet Tonghop vào sheet DanhSach

 

[befaint]

Xóa 2 dòng
Sh.Range("A8").Select
Selection.AutoFilter
----
Dòng này
Sh.Range("$A$8:E" & Lrow).AutoFilter Field:=1, Criteria1:="<>"
đổi thành

Sh.Range("A8:A" & Lrow).AutoFilter Field:=1, Criteria1:="<>"

 

[LienDong]

Xóa 2 dòng
Sh.Range("A8").Select
Selection.AutoFilter
----
Dòng này
Sh.Range("$A$8:E" & Lrow).AutoFilter Field:=1, Criteria1:="<>"
đổi thành

Sh.Range("A8:A" & Lrow).AutoFilter Field:=1, Criteria1:="<>"

Nó copy cả định dạng luôn, làm cách nào chỉ copy số liệu không vậy các bạn