Xin code copy số liệu từ tháng cũ sang tháng mới (trong cùng 1 Table) (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

phucbugis

Thành viên tích cực
Tham gia
22/6/13
Bài viết
1,270
Được thích
981
Xin chào các bạn GPE,

Mình có 1 sheet Baohiem, hàng tháng phải copy số liệu từ tháng cũ (ví dụ: Tháng 12-2013) sang tháng mới (Tháng 1-2014) với điều kiện:
1. Nhân viên đó đang làm việc.
2. Tháng cũ = 12 và Năm cũ = 2013

Vậy làm sao để kết quả của Tháng mới và Năm mới sẽ đưa thẳng vào Table1 của sheet Baohiem (nằm bên dưới T12-2013)

Mong mọi người giúp đỡ :-=

Mình đã làm được rồi --=0, cảm ơn các bạn đã quan tâm.
Mã:
Sub copyBaohiem()
Dim nguon1(), nguon2(), nguon3(), i, K, L, M
    With Sheets("Baohiem")
       nguon1 = Range("Table1") 'hoac: nguon = .Range(.[B8], .[B65536].End(xlUp)).Resize(, 17).Value
       For i = 1 To UBound(nguon1)
          If nguon1(i, 13) = 2013 And nguon1(i, 12) = 12 And nguon1(i, 1) = 0 Then
             K = K + 1
             nguon1(K, 1) = nguon1(i, 2)
          End If
       Next
       
       nguon2 = Range("Table1")
       For i = 1 To UBound(nguon2)
            If nguon2(i, 13) = 2013 And nguon2(i, 12) = 12 And nguon2(i, 1) = 0 Then
                L = L + 1
                nguon2(L, 1) = nguon2(i, 8)
                nguon2(L, 2) = nguon2(i, 9)
                nguon2(L, 3) = nguon2(i, 10)
                nguon2(L, 4) = nguon2(i, 11)
                nguon2(L, 5) = 1
                nguon2(L, 6) = 2014
                nguon2(L, 7) = nguon2(i, 14)
            End If
       Next
       
       nguon3 = Range("Table1")
       For i = 1 To UBound(nguon3)
          If nguon3(i, 13) = 2013 And nguon3(i, 12) = 12 And nguon3(i, 1) = 0 Then
             M = M + 1
             nguon3(M, 1) = nguon3(i, 16)
             nguon3(M, 2) = Date
          End If
       Next
       
    End With
    
    ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Offset(1, -1).Value = "stop"
    With ActiveSheet.Cells(Rows.Count, "A")
        .End(xlUp).Offset(0, 2).Resize(K, 1) = nguon1
        .End(xlUp).Offset(0, 8).Resize(L, 6) = nguon2
        .End(xlUp).Offset(0, 16).Resize(M, 2) = nguon3
    End With
    
    With ActiveSheet.Cells(Rows.Count, "A")
        If .End(xlUp).Value = "stop" Then
            .End(xlUp).Value = Empty
            GoTo Ketthuc
        Else
            MsgBox ("Xay ra loi~"), vbExclamation
        End If
    End With


Ketthuc:
    MsgBox ("xong")
End Sub
Link MediaFire: bt copy so lieu
 
Lần chỉnh sửa cuối:
Web KT

Bài viết mới nhất

Back
Top Bottom