Xác định dòng cuối cùng của file đang đóng. Cập nhật kết quả từ file vào file đóng

[quyenpv]

Kính gửi các anh!
Hiện tại em hay làm thống kê từ các bộ phận gửi thông tin hợp đồng về để tôgr hợp, nhu cầu mong muốn các anh giúp em tự đồng cập nhật dữ liệu mới vào file đang đóng
Nhờ anh chị bổ sung check trùng hợp đồng trong file đóng tại cột D
Cám ơn anh chị nhiều
1. Dữ liệu tại file đóng

2. Dữ liệu thao tác để cập nhật vào file đóng

 

[Maika8008]

Sao cả ngày rồi mà chẳng thấy ai lên tiếng nhỉ? Bạn @HUONGHCKT cũng giống như tôi, chắc đang nghỉ cuối tuần rồi

 

[Hoàng Tuấn 868]

Chắc mọi người cũng đang "rút kinh nghiệm" đây mà.

 

[Maika8008]

Kính gửi các anh!
Hiện tại em hay làm thống kê từ các bộ phận gửi thông tin hợp đồng về để tôgr hợp, nhu cầu mong muốn các anh giúp em tự đồng cập nhật dữ liệu mới vào file đang đóng
Nhờ anh chị bổ sung check trùng hợp đồng trong file đóng tại cột D
Cám ơn anh chị nhiều
1. Dữ liệu tại file đóng
View attachment 268844
2. Dữ liệu thao tác để cập nhật vào file đóng

View attachment 268845

File cập nhật dữ liệu (Sửa đường dẫn và tên trong code)

 

[quyenpv]

File cập nhật dữ liệu (Sửa đường dẫn và tên trong code)

Dạ cám ơn anh, code đúng ý em rồi ạ
Anh bổ sung giúp em ktra điều kiện trùng theo số hợp đồng với ạ, nếu trùng thì cập nhật còn ngược lại thì thêm mới ạ

 

[Maika8008]

Dạ cám ơn anh, code đúng ý em rồi ạ
Anh bổ sung giúp em ktra điều kiện trùng theo số hợp đồng với ạ, nếu trùng thì cập nhật còn ngược lại thì thêm mới ạ

Thay cho code cũ:

Sub CapNhat()
    Dim arrRg, arrCol, sWb As Workbook, dWb As Workbook
    Dim i&, rw&, strFind$, fPath$, fName
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Set sWb = ThisWorkbook
    arrRg = Array("D36", "D33", "G34", "D37", "D7")
    arrCol = Array(2, 4, 5, 6, 7)
    fPath = "D:\TestGPE" & "\"   'Thay duong dan
    fName = "File Data_Dong.xlsx"  'Thay ten file dang dong
    Set dWb = Workbooks.Open(fPath & fName, UpdateLinks:=0)
    strFind = sWb.Sheets("CDT_RG").Range(arrRg(1))
    On Error Resume Next
    rw = dWb.Sheets("ChiPhi").Range("D7:D10000").Find(What:=strFind, LookIn:=xlFormulas, LookAt:=xlWhole).Row
    If Err.Number = 91 Then
        rw = dWb.Sheets("ChiPhi").Range("B" & Rows.Count).End(xlUp).Row + 1
        On Error GoTo 0
    End If
    For i = 0 To UBound(arrRg)
        dWb.Sheets("ChiPhi").Cells(rw, arrCol(i)).Value = sWb.Sheets("CDT_RG").Range(arrRg(i)).Value
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    dWb.Close True
    Set dWb = Nothing
    Set sWb = Nothing
    MsgBox "Xong!"
End Sub

 

[quyenpv]

Dạ cám ơn anh, code chạy đúng như mong muốn rồi ạ