Coppy Values เฉพาะ Collum ที่ต้องการไปวางต่อในฐานข้อมูลเดิมตาม ID ของสินค้าที่มีอยู่

[piches]

ผมต้องการวางค่าต่อจากเดิมที่มีอยู่คือcollum A-B หากID ตรงกันให้วางที่ Collum C ที่ workbook db.xlsx code ที่ผมเขียนไว้จะ Coppy ทั้งแถว
หากต้องการเฉพาะ Collum ที่ต้องการผมต้องแก้ไขอย่างไร ครับ

Code: Select all

Sub test()
Dim rall As Range, r As Range
    Dim dataAll As Range
    Dim l As Long, allRows As Long
    Application.ScreenUpdating = False
    With Worksheets("sheet1")
        If .Range("B2").Value <= "0" Then 'End
         MsgBox "äÁèÁÕ ID ¹Õéã¹Ãкº", vbCritical
           Exit Sub
           End If
        Set rall = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    End With
    
    Set wb = Workbooks.Open("C:\Users\IT\Desktop\New folder\db.xlsx", False, False)
    With wb.Sheets("sheet1")
        Set dataAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
        allRows = dataAll.Rows.Count
    End With
    
    For Each r In rall
        For l = allRows To 1 Step -1
            If dataAll(l).Value = r.Value Then
                r.Resize(1, 3).Copy
                dataAll(l).Resize(1, 3).Font.Color = -4165632
                dataAll(l).Resize(1, 3).PasteSpecial xlPasteValues
                Application.CutCopyMode = False
                Application.ScreenUpdating = True
                Exit For
            End If
        Next l
    Next r
    wb.Close True
    Worksheets("sheet1").Range("A2:A10,C2:C10").ClearContents
    Range("A2").Activate
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

If dataAll(l).Value = r.Value Then
    r.Offset(0, 2).Copy
    dataAll(l).Resize(1, 3).Font.Color = -4165632
    dataAll(l).Offset(0, 2).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Exit For
End If

[piches]

ขอบคุณครับอาจารย์ ใช้ได้ตามต้องการแล้วครับ สอบถามเพิ่มเติมครับ
(ถ้าต้องการ coppy collum c ,e,i )
(แล้วว่าง collum c,e,i)

Code: Select all

r.Offset(1, 3).Copy
                dataAll(l).Resize(1, 9).Font.Color = -4165632
                dataAll(l).Offset(1, 3).PasteSpecial xlPasteValues

ทำได้หรือไม่ครับ

[snasui]

จะ Copy อะไร จากไหน ไปไหน ทำได้ทั้งนั้นครับ ลองทำมาเอง ติดแล้วค่อยถามกันต่อครับ