Nhờ anh chị viết code VBA điền giá trị từ sheet này sang sheet khác có điều kiện.

[baggiotung]

Mình có file theo dõi vật tư gồm 2 sheet. sheet nhập liệu và sheet data. Nhờ các anh chị viết giúp code VBA đề khi bấm nút "nạp dữ liệu" thì các giá trị ở sheet nhập liệu chạy qua sheet data với điều kiện chỉ nạp các hàng có giá trị ở cột khối lượng thôi ạ. Kết quả mình mong muốn là các dòng màu đỏ ở sheet data.
Xin cám ơn các anh chị.!

 

[giaiphap]

Mình có file theo dõi vật tư gồm 2 sheet. sheet nhập liệu và sheet data. Nhờ các anh chị viết giúp code VBA đề khi bấm nút "nạp dữ liệu" thì các giá trị ở sheet nhập liệu chạy qua sheet data với điều kiện chỉ nạp các hàng có giá trị ở cột khối lượng thôi ạ. Kết quả mình mong muốn là các dòng màu đỏ ở sheet data.
Xin cám ơn các anh chị.!

Dùng code sau thử.

Sub GPE()
Dim sArr(), dArr, i As Integer, j As Integer, k As Integer, stt As Integer
With Sheet1
    j = .Range("C2000").End(xlUp).Row
    If j = 10 Then
        MsgBox "Chua co du lieu de them"
        Exit Sub
    End If
    sArr = Sheet1.Range("C11:G" & Sheet1.Range("C2000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 13)
    stt = Sheet2.Range("B1000000").End(xlUp).Row - 5
    k = 0
    For i = 1 To UBound(sArr, 1)
        If sArr(i, 4) <> "" Then
            k = k + 1
            dArr(k, 1) = stt + k
            For j = 2 To 5
                dArr(k, j) = sArr(i, j - 1)
            Next j
            dArr(k, 6) = .Range("E2")
            dArr(k, 7) = .Range("H2")
            dArr(k, 8) = .Range("E6")
            dArr(k, 9) = .Range("H6")
            dArr(k, 10) = .Range("E4")
            dArr(k, 11) = .Range("H4")
            dArr(k, 12) = .Range("E8")
            dArr(k, 13) = .Range("H8")
        End If
    Next i
    If k Then Sheet2.Range("B" & (stt + 6)).Resize(k, 13).Value = dArr
End With
MsgBox "Da nap du lieu xong"
End Sub

 

[Nhattanktnn]

Mình có file theo dõi vật tư gồm 2 sheet. sheet nhập liệu và sheet data. Nhờ các anh chị viết giúp code VBA đề khi bấm nút "nạp dữ liệu" thì các giá trị ở sheet nhập liệu chạy qua sheet data với điều kiện chỉ nạp các hàng có giá trị ở cột khối lượng thôi ạ. Kết quả mình mong muốn là các dòng màu đỏ ở sheet data.
Xin cám ơn các anh chị.!

Sao mã vật tư lại trùng nhau vậy bạn:

 

[baggiotung]

Sao mã vật tư lại trùng nhau vậy bạn:
View attachment 269054

Mình lấy ví dụ thôi, ko để ý trùng, cám ơn bạn nhé

Bài đã được tự động gộp: 12/11/21

Sao mã vật tư lại trùng nhau vậy bạn:
View attachment 269054

Dùng code sau thử.

Sub GPE()
Dim sArr(), dArr, i As Integer, j As Integer, k As Integer, stt As Integer
With Sheet1
    j = .Range("C2000").End(xlUp).Row
    If j = 10 Then
        MsgBox "Chua co du lieu de them"
        Exit Sub
    End If
    sArr = Sheet1.Range("C11:G" & Sheet1.Range("C2000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 13)
    stt = Sheet2.Range("B1000000").End(xlUp).Row - 5
    k = 0
    For i = 1 To UBound(sArr, 1)
        If sArr(i, 4) <> "" Then
            k = k + 1
            dArr(k, 1) = stt + k
            For j = 2 To 5
                dArr(k, j) = sArr(i, j - 1)
            Next j
            dArr(k, 6) = .Range("E2")
            dArr(k, 7) = .Range("H2")
            dArr(k, 8) = .Range("E6")
            dArr(k, 9) = .Range("H6")
            dArr(k, 10) = .Range("E4")
            dArr(k, 11) = .Range("H4")
            dArr(k, 12) = .Range("E8")
            dArr(k, 13) = .Range("H8")
        End If
    Next i
    If k Then Sheet2.Range("B" & (stt + 6)).Resize(k, 13).Value = dArr
End With
MsgBox "Da nap du lieu xong"
End Sub

Code chạy rất ổn và nhanh, cám ơn bạn nhiều nhé