Copy những dòng có Stt liền nhau (1 người xem)

[toandiennuoc123]

Chào các bạn! Tôi muốn tạo sub copy những dòng liền nhau theo số thứ tự (STT) sang sheet khác, các bạn xem chi tiết trong file đính kèm.

 

[toandiennuoc123]

Đơn giản thì thế này xem

Public Sub GPE()
With Sheets("Dulieu")
    .Range("A9").AutoFilter 1, "<>"
    .Range("B9").Resize(.Range("B6500").End(3).Row - 8, 6).SpecialCells(12).Copy
    .AutoFilterMode = False
End With
With Sheets("TongHop")
    .Range("B9").PasteSpecial xlPasteValues
End With
End Sub

Về cơ bản là được nhưng nó bị bôi đen phần paste ở sheet TH và bị đánh dấu ở sheet Dữ liệu phải ESC thì mới hết, nhờ bạn xem lại nhé.

 

[killitmore]

Về cơ bản là được nhưng nó bị bôi đen phần paste ở sheet TH và bị đánh dấu ở sheet Dữ liệu phải ESC thì mới hết, nhờ bạn xem lại nhé.

bôi đen phần paste ở sheet TH, bác thêm 1 dòng sau khi paste chọn 1 cái địa chỉ khác của sheet TH theo ý muốn là được
bị đánh dấu ở sheet Dữ liệu phải ESC, thêm dòng sau ở cuối sub

[COLOR=#000000][FONT=Consolas]Application.CutCopyMode=False[/FONT][/COLOR]

 

[toandiennuoc123]

Public Sub GPE()
With Sheets("Dulieu")
    .Range("A9").AutoFilter 1, "<>"
    .Range("B9").Resize(.Range("B6500").End(3).Row - 8, 6).SpecialCells(12).Copy
    .AutoFilterMode = False
End With
With Sheets("TongHop")
    .Range("B9").PasteSpecial xlPasteValues
   [COLOR=#ff0000][B] .Range("A1").Activate[/B][/COLOR]
End With
Application.CutCopyMode = False
End Sub

Bị lỗi dòng này .Range("A1").Activate
Mà cũng chưa đáp ứng được yêu cầu của Sheet TH là phần Paste thì cứ nối tiếp nhau...

 

[killitmore]

Em xài advance filter thay cho auto filter bác hpkhuong ạ

Option Explicit

Sub loc_du_lieu()
Dim lrow As Long
    Sheets("Dulieu").Activate
    lrow = Cells(Rows.Count, 7).End(xlUp).Row
    
    Range("XY2").Formula = "=A8<>"""""
    Range("A7", "A" & lrow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "XY1:XY2"), CopyToRange:=Range("WGX7"), Unique:=False
    
    Sheets("TongHop").Activate
    
    With Sheets("Dulieu")
        .Range("A7:G18").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
            "WGX7:WGX16"), CopyToRange:=Range("A7"), Unique:=False
        .Range("WGX7").CurrentRegion.Clear
        .Range("XY2").Clear
    End With
    
    Range("A8", Range("A8").End(xlDown)).ClearContents
End Sub