Hỏi về lệnh VBA tách dư liệu từ 1 sheet thành nhiều sheet khác nhau

Chia sẻ bởi:hands

★★★★★

‹ Tìm tổng lớn nhất theo điều kiện Dùng vòng lặp để tách mỗi lần... ›

Quảng cáo

rất mong nhận được sư giúp đỡ của các bác ạ

Em có 1 file dư liệu muốn tách dư liêu bằng lệnh VBA từ 1 sheet ban đầu ra thành nhiều sheet dưa vào chữ STT tại cột A. Lệnh VBA chạy cứ gặp chứ STT là toàn bộ dữ liệu sau ròng stt đó được tách thành 1 sheet. Em có vidu dư liệu tách mong muốn tại 2 sheet kết quả 1 và 2. rất mong nhận được sư giúp đỡ của các bác ạ

Viết đại cái code nháp này, trong khi chờ các cao thủ vào giúp
Lưu ý:
1) Nếu có n STT thì sẽ tạo n sheet, với tên sheet là từ Ketqua 1 đến Ketqua n
2) Có 1 nút bấm ghi chữ "TÁCH SHEET", đừng bấm khi không có nhu cầu.

Option Explicit
Sub nhanbansheet()
Dim lr&, i&, maxS, ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Sheets
    If ws.Name <> "kiem tra" Then ws.Delete
Next
With Sheets("kiem tra")
    lr = .Cells(Rows.Count, 1).End(xlUp).Row
    Application.CopyObjectsWithCells = False
    .Copy after:=Sheets(Sheets.Count)
    Application.CopyObjectsWithCells = True
End With
With ActiveSheet
    .Name = "temp"
    With .Range("AY1:AY" & lr)
        .Formula = "=COUNTIF($A$1:A1,""STT"")"
        .Value = .Value
    End With
    maxS = .Cells(lr, "AY").Value
End With
For i = 1 To maxS
    Sheets("Temp").Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = "Ketqua " & i
        With .Range("AZ1:AZ" & lr)
            .Value = "=$AY$1:$AY$" & lr & "/($AY$1:$AY$" & lr & "=" & i & ")"
            .SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
        End With
        .Columns("AY:AZ").Delete
    End With
Next
Sheets("Temp").Delete
Sheets("kiem tra").Activate
Application.ScreenUpdating = True
End Sub

www.giaiphapexcel.com/diendan/threads/h%E1%BB%8Fi-v%E1%BB%81-l%E1%BB%87nh-vba-t%C3%A1ch-d%C6%B0-li%E1%BB%87u-t%E1%BB%AB-1-sheet-th%C3%A0nh-nhi%E1%BB%81u-sheet-kh%C3%A1c-nhau.166353/