开发者

Copy and Paste Cell Contents to Different Sheet Based on Condition

I've seen similar posts, but nothing that has directly addressed my current problem...

I have a workbook with 2 sheets (Sheet1 and Sheet 2). In Sheet1, there are 2 columns - column A contains part numbers from our old ERP system and column B contains weights. In Sheet2, I have 2 columns - column A contains part numbers from our new ERP system and column B contains alias part numbers.

I would like to have a macro read in the part number in Sheet1 (which sits in column A) and see if that value exists in Sheet2 in either column A or column B. If it finds a match, it would need to copy the corresponding weight to column C on Sheet2.

I am a novice at writing macros and I've attached a modified 开发者_JAVA技巧version of code posted to a similar problem. Any help would be greatly appreciated - thank you in advance to any replies.

Sub CopyCells()

    Application.ScreenUpdating = False

    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim j As Long, i As Long, lastrow1 As Long, lastrow2 As Long

    Set sh1 = Worksheets("Sheet1")
    Set sh2 = Worksheets("Sheet2")

    lastrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
    lastrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row

    For i = 2 To lastrow1
        For j = 2 To lastrow2
            If sh1.Cells(i, "A").Value = sh2.Cells(j, "A").Value Or _
                sh1.Cells(i, "A").Value = sh2.Cells(j, "B").Value Then

                sh1.Cells(i, "B").Value = sh2.Cells(j, "C").Value
            End If
        Next j
    Next i

    Application.ScreenUpdating = True

End Sub


This might help get you started. I am assuming you have data starting in row 1 in columns A and B of Sheet1 and Sheet2 and that you want to copy weights to Column C in Sheet2 :

Sub GetMatches()

    Dim PartRngSheet1 As Range, PartRngSheet2 As Range
    Dim lastRowSheet1 As Long, lastRowSheet2 As Long
    Dim cl As Range, rng As Range

    lastRowSheet1 = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
    Set PartRngSheet1 = Worksheets("Sheet1").Range("A1:A" & lastRowSheet1) 

    lastRowSheet2 = Worksheets("Sheet2").Range("B65536").End(xlUp).Row
    Set PartRngSheet2 = Worksheets("Sheet2").Range("A1:A" & lastRowSheet2)

    For Each cl In PartRngSheet1
        For Each rng In PartRngSheet2
            If (cl = rng) Or (cl = rng.Offset(0, 1)) Then
                rng.Offset(0, 2) = cl.Offset(0, 1)
            End If 
        Next rng
    Next cl
End Sub
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜