Giúp mình với code Phiếu nhập ghi phiếu sau đè lên phiếu trước khi lưu sang data (1 người xem)

[chicpt]

Nhờ các cao thủ giúp dùm nha . mình loay hoay mãi không được.
[GPECODE=vb]
Sub Loc_PhieuNhap()
Application.ScreenUpdating = False
Dim WsN As Worksheet
Dim WsD As Worksheet
Set WsN = Sheets("PN")
Set WsD = Sheets("DL")
With WsN
.AutoFilterMode = False
endR = .Range("m100").End(xlUp).Row
C_TU = WsN.Range("D5")
Set rngDG = .Range("a9:m" & endR)
Set rngNo = .Range("m9:m" & endR)
Set rngCo = .Range("n9:n" & endR)

End With
Dim rngData As Range
s = 0

Dim arrKQ(1 To 100, 1 To 13) ' ==== "TO" bao nhieu cot tren phieu can copy sang
Set rngData = Union(rngNo, rngCo)
arrTK = rngData.Value
arrDG = rngDG.Value

For i = 1 To UBound(arrTK)

'Copy du lieu co dieu kien . Bao nhieu cot thi bay nhieu dong lenh
If arrTK(i, 1) = C_TU Then
s = s + 1
arrKQ(s, 1) = arrDG(i, 1)
arrKQ(s, 2) = arrDG(i, 2)
arrKQ(s, 3) = arrDG(i, 3)
arrKQ(s, 4) = arrDG(i, 4)
arrKQ(s, 5) = arrDG(i, 5)
arrKQ(s, 6) = arrDG(i, 6)
arrKQ(s, 7) = arrDG(i, 7)
arrKQ(s, 8) = arrDG(i, 8)
arrKQ(s, 9) = arrDG(i, 9)
arrKQ(s, 10) = arrDG(i, 10)
arrKQ(s, 11) = arrDG(i, 11)
arrKQ(s, 12) = arrDG(i, 12)
arrKQ(s, 13) = arrDG(i, 13)
End If

Next
If s = 0 Then Exit Sub
With WsD

With .Range("Bd")
'ActiveCell.Offset(Range("dem").Value, 0).Select

.Resize(s, 13) = arrKQ
End With
End With
Set rngData = Nothing
Erase arrTK, arrKQ, arrDG


Application.ScreenUpdating = True

End Sub
[/GPECODE]

Ai ơi, sao không thấy pro nao cứu mình với! Buồn quá đi.....

 

[viehoai]

Nhờ các cao thủ giúp dùm nha . mình loay hoay mãi không được.

Sub Loc_PhieuNhap()
Application.ScreenUpdating = False
Dim WsN As Worksheet
Dim WsD As Worksheet
Set WsN = Sheets("PN")
Set WsD = Sheets("DL")
With WsN
.AutoFilterMode = False
endR = .Range("m100").End(xlUp).Row
C_TU = WsN.Range("D5")
Set rngDG = .Range("a9:m" & endR)
Set rngNo = .Range("m9:m" & endR)
Set rngCo = .Range("n9:n" & endR)

End With
Dim rngData As Range
s = 0

Dim arrKQ(1 To 100, 1 To 13) ' ==== "TO" bao nhieu cot tren phieu can copy sang
Set rngData = Union(rngNo, rngCo)
arrTK = rngData.Value
arrDG = rngDG.Value

For i = 1 To UBound(arrTK)

'Copy du lieu co dieu kien . Bao nhieu cot thi bay nhieu dong lenh
If arrTK(i, 1) = C_TU Then
s = s + 1
arrKQ(s, 1) = arrDG(i, 1)
arrKQ(s, 2) = arrDG(i, 2)
arrKQ(s, 3) = arrDG(i, 3)
arrKQ(s, 4) = arrDG(i, 4)
arrKQ(s, 5) = arrDG(i, 5)
arrKQ(s, 6) = arrDG(i, 6)
arrKQ(s, 7) = arrDG(i, 7)
arrKQ(s, 8) = arrDG(i, 8)
arrKQ(s, 9) = arrDG(i, 9)
arrKQ(s, 10) = arrDG(i, 10)
arrKQ(s, 11) = arrDG(i, 11)
arrKQ(s, 12) = arrDG(i, 12)
arrKQ(s, 13) = arrDG(i, 13)
End If

Next
If s = 0 Then Exit Sub
With WsD

With .Range("Bd")
'ActiveCell.Offset(Range("dem").Value, 0).Select

.Resize(s, 13) = arrKQ
End With
End With
Set rngData = Nothing
Erase arrTK, arrKQ, arrDG


Application.ScreenUpdating = True

End Sub


Ai ơi, sao không thấy pro nao cứu mình với! Buồn quá đi.....

Bạn nói rõ trong file trên điều bạn cần là gì vậy?

 

[chicpt]

Cả nhà cố gắng giúp sớm nha!

 

[nghiaphuc]

---> http://www.giaiphapexcel.com/forum/...hiếu-2-trở-đi-sang-data-bị-đè-lên-phiếu-trước