Sửa lại code triết xuất dữ liệu

[boybh2312]

Chào mọi người ở diễn đàn, em có dựa theo code trên mạng cho file excel quản lý cdf amend như file đính kèm nhưng code của em bị kẹt ở chỗ filter, vì em đã định dang table để chạy dashboard ở sheet tiếp theo. Mục tiêu của em code này là khi chạy code sẽ tạo ra 3 sheet approved, processing, reject mỗi trường hợp 1 sheet và có thêm 1 sub nữa nhờ mọi người tư vấn dùm em dùng để xóa 3 sheet vừa tạo luôn ạ. Nhờ mọi người hỗ trợ. Thanks mọi người!

'filter
startcell.CurrentRegion.AutoFilter Field:=19, Criteria1:=ws.Cells(ac, 29)
startcell.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy

 

[Maika8008]

Chào mọi người ở diễn đàn, em có dựa theo code trên mạng cho file excel quản lý cdf amend như file đính kèm nhưng code của em bị kẹt ở chỗ filter, vì em đã định dang table để chạy dashboard ở sheet tiếp theo. Mục tiêu của em code này là khi chạy code sẽ tạo ra 3 sheet approved, processing, reject mỗi trường hợp 1 sheet và có thêm 1 sub nữa nhờ mọi người tư vấn dùm em dùng để xóa 3 sheet vừa tạo luôn ạ. Nhờ mọi người hỗ trợ. Thanks mọi người!

'filter
startcell.CurrentRegion.AutoFilter Field:=19, Criteria1:=ws.Cells(ac, 29)
startcell.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy

Bạn thay 2 dòng đó bằng 2 dòng sau:

    startcell.Resize(startcell.End(xlDown).Row - 3, startcell.End(xlToRight).Column - 1).AutoFilter Field:=18, Criteria1:=ws.Cells(ac, 29)
    startcell.Resize(startcell.End(xlDown).Row - 3, startcell.End(xlToRight).Column - 1).SpecialCells(xlCellTypeVisible).Copy

 

[boybh2312]

File của mình chạy được rồi nha. Cảm ơn bạn Maika8008 nhiều

 

[boybh2312]

Nhờ bạn Maika8008 thêm 1 file nữa nha, mình cũng bị vướng lỗi code triết xuất, dữ liệu mình muốn triết xuất là cột C theo số BU. File hoàn thành sẽ ra các BU TV2,TV2,TV5.
P/s: còn 1 yêu cầu nữa là cho sub luufile, khi mình ấn vào No để chọn sheet thì nó ko tạo ra sheet riêng như mình muốn được, giải pháp duy nhất của mình là bấm yes và nó tạo ra 1 sheet y chang, mình phải xóa các sheet ko dùng. Nhờ bạn giúp với nha. Thanks!

 

[BuiQuangThuan]

Nhờ bạn Maika8008 thêm 1 file nữa nha, mình cũng bị vướng lỗi code triết xuất, dữ liệu mình muốn triết xuất là cột C theo số BU. File hoàn thành sẽ ra các BU TV2,TV2,TV5.
P/s: còn 1 yêu cầu nữa là cho sub luufile, khi mình ấn vào No để chọn sheet thì nó ko tạo ra sheet riêng như mình muốn được, giải pháp duy nhất của mình là bấm yes và nó tạo ra 1 sheet y chang, mình phải xóa các sheet ko dùng. Nhờ bạn giúp với nha. Thanks!

Sửa lại 1 chút sub trietxuat

Sub trietxuat()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Re_export")
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Copy va remove duplicate de lay cac trang thai
ws.Columns(3).Copy

ws.Columns(29).PasteSpecial xlPasteValues
ws.Range("ac5").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
' ket thuc loc cac trang thai
' loc cac trang thai va copy
Dim ac%
Dim nws As Worksheet, tenFile As Worksheet
Dim startcell As Range
Set startcell = ws.Range("B5")
ac = 6
While (ws.Cells(ac, 29) <> "")
    'tao sheet moi nam o cuoi
    For Each tenFile In Worksheets
        If tenFile.Name = ws.Cells(ac, 29).Value Then
            tenFile.Delete
        End If
    Next
    Worksheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    Set nws = ActiveSheet
    
    nws.Name = ws.Cells(ac, 29)
    ws.ListObjects("Table2").Range.AutoFilter Field:=2, Criteria1:=ws.Cells(ac, 29)
    'filter
    
    
    'startcell.Resize(startcell.End(xlDown).Row - 3, startcell.End(xlToRight).Column - 1).AutoFilter Field:=2, Criteria1:=ws.Cells(ac, 29)
    startcell.Resize(startcell.End(xlDown).Row - 3, startcell.End(xlToRight).Column - 1).SpecialCells(xlCellTypeVisible).Copy
    nws.Range("A1").PasteSpecial
    nws.Cells.EntireColumn.AutoFit
    ws.Select
    startcell.AutoFilter
    
ac = ac + 1
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
startcell.Select
ws.Columns(29).Delete
MsgBox "Da hoan thanh, Finished !!!"
End Sub

Còn ý sau chưa hiểu nên chẳng biết sửa như thế nào