Help..Marco tạo sheet và tách dữ liệu theo tháng...

Liên hệ QC

thanhhoang5393

Thành viên mới
Tham gia
25/3/18
Bài viết
5
Được thích
0
Giới tính
Nam
Dạ mấy anh chị các cao thử xem giúp e cái..e tao cai macro nay để lọc dữ liệu từ sheet Nhật Kí Chung
Nhưng sao nó vẫn cứ bị gặp lỗi khi lọc tạo thêm file dư
Với khi chạy lọc dự liệu các sheet vữa tạo theo tháng em định dạng là kết thúc tháng thì chèn 3 hàng trống thì nó lại hk dc..cứ 1 row nó lại chèn vào
A chị nào giúp em với.
Dạ đoán code của e
Mấy a chj tải về coi rõ giùm e
"
Sub TAO_MA()
Dim i As Long
Dim sh As Worksheet
Dim c As Long
Dim n As Long
Dim z As Long
Dim e As Long
Dim f As Long
Dim my_array As Variant
'Dai dien COT E cot chon gia tri de loc
Dim d As Object
'DONG CUOI CUNG CHUA DU LIEU
Dim endrow As Long
'LUU TIEU DE BAN TINH A1-G1
Dim Header As String
Dim v As Variant
'CHAY NHANH HON
Application.ScreenUpdating = False
'TAO TU DIEN
Set d = CreateObject("Scripting.Dictionary")
Set sh = Sheets("NHAT KI CHUNG")
'DONG CUOI CONG CHUA DU LIEU TRONG COT 5
endrow = sh.Cells(sh.Rows.Count, 5).End(xlUp).Row
Header = "A10:H10"
'LUU GIA TRI COT B KHONG LUU TIEU DE THANH BANG DU LIEU TRONG VBA
my_array = Application.WorksheetFunction.Transpose(sh.Range(Cells(11, 5), Cells(endrow, 5)))
'Them cac gia tri vao ARRAY VUA TAO VAO BIEN d
For i = LBound(my_array) To UBound(my_array)
'BIEN TAT CA VALUE THANH 1_oke
d(my_array(i)) = 1
Next i
'V LA KEY TRONG ARRAY
For Each v In d.keys()
'LOC DU LIEU
sh.Range(Header).AutoFilter field:=5, Criteria1:=v
'An cot E
sh.Columns(5).Hidden = True
'TAO VAN BAN tu MAU
Sheets("MAU").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = v
'Chon vung du lieu file NKC va copy
sh.Select
sh.Range(Header).Offset(1).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Chon vung LUU
Sheets(v).Select
Sheets(v).Range("A8").Select
ActiveSheet.Paste
'Chen cuoi nam + chu ki
c = Sheets(v).Cells(Rows.Count, 1).End(xlUp).Row
z = Sheets(v).Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A100003:G100005").Select
Selection.Copy
ActiveSheet.Cells(z, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'Tinh tong thang
For e = 8 To c
n = e + 1
If Month(Cells(e, 1)) = Month(Cells(c, 1)) Then
ActiveSheet.Cells(z + 1000, 1).Value = 1
Else: Month (Cells(e, 1)) < Month(Cells(n, 1))
Range("A" & e, "G" & e).Offset(1).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A100000:G100002").Select
Selection.Copy
Cells(z, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next e
'Xoa chu ki file moi
Sheets(v).Rows("1048570:1048576").Select
Selection.Delete Shift:=xlUp
'Hien cot E
sh.Select
Columns("D:F").Select
Selection.EntireColumn.Hidden = False
'Tat autofillter
sh.AutoFilterMode = False
sh.Activate
Next v
'TAT CHAY NHANH HON Sheets(v).Columns.AutoFit
Application.ScreenUpdating = True

End Sub"
 

File đính kèm

  • SOCAI_MC.xlsm
    190.6 KB · Đọc: 13
Lần chỉnh sửa cuối:
Web KT
Back
Top Bottom