0

I know this has been done before, but I am running into an issue in where I want to change part of this script, I just don't know how.

This is the code, below it is what I need to do.

Option Explicit

Sub PENCMR()
    Dim i As Integer

    With Application
        .ScreenUpdating = False
    End With

    'Internal NCMR
    Dim wsPE As Worksheet
    Dim wsNDA As Worksheet

    'Copy Ranges
    Dim c As Variant

    'Paste Ranges
    Dim p As Range

    'Setting Sheet
    Set wsPE = Sheets("Print-Edit NCMR")
    Set wsNDA = Sheets("NCMR Data")
    Set p = wsPE.Range("A54:U54")

    With wsPE
        c = Array(.Range("AG3"), .Range("B11"), .Range("B14"), .Range("B17"), .Range("B20"), .Range("B23") _
                , .Range("Q11"), .Range("Q14"), .Range("Q17"), .Range("Q20"), .Range("R25"), .Range("V23") _
                , .Range("V25"), .Range("V27"), .Range("B32"), .Range("B36"), .Range("B40"), .Range("B44") _
                , .Range("D49"), .Range("L49"), .Range("V49"))
    End With

    For i = LBound(c) To UBound(c)
        p(i + 1).Value = c(i).Value
    Next

    With wsNDA
        Dim rFind As Long, NR As Long, LR As Long, LC As Long
        LR = .Range("C" & Rows.Count).End(xlUp).Row
        LC = .Cells(2, Columns.Count).End(xlToLeft).Column
        NR = LR + 1
        rFind = wsNDA.Range("A3:A" & LR).Find(wsPE.Range("A54:U54")).Row

        .Range("A54", .Cells(2, LC)).Copy
        .Range("A" & rFind).PasteSpecial xlPasteValues
        .Range("A54", .Cells(1, LC)).ClearContents
    End With

    With Application
        .ScreenUpdating = True
    End With
End Sub

The script is meant to do this:

When the code is activated, it is meant to copy all cells and then paste them into a row below the form and then after referencing the 2nd page comparing the first cell of the newly created row to the 2nd page list copy and replace the information.

What I'd like to see, since I've been told that it can be done without pasting onto the same page, is copy the data, do a search for the ID number on the 2nd sheet, and paste over said row with the new data.

Here is the sheet:

Excel Replace WkSht

The way this is written now, it doesn't replace the information, it just overwrites it with blank information. Which I've yet to figure out why... hopefully with this request rewrite, I'll be able to get that resolved.

Thanks again for the help. This place has been amazing in what they have done so far in helping me not only learn, but to write smartly in the long run.

4

1 に答える 1

1

いくつかの提案された変更:

Sub PENCMR()
    Dim i As Integer

    'Internal NCMR
    Dim wsPE As Worksheet
    Dim wsNDA As Worksheet
    Dim c As Variant 'Copy Ranges
    Dim p As Range 'Paste Ranges

    Application.ScreenUpdating = False

    'Setting Sheet
    Set wsPE = Sheets("Print-Edit NCMR")
    Set p = wsPE.Range("A54:U54")

    Set wsNDA = Sheets("NCMR Data")

    c = Array("AG3", "B11", "B14", "B17", "B20", "B23" _
            , "Q11", "Q14", "Q17", "Q20", "R25", "V23" _
            , "V25", "V27", "B32", "B36", "B40", "B44" _
            , "D49", "L49", "V49")

    For i = LBound(c) To UBound(c)
        p(i + 1).Value = wsPE.Range(c(i)).Value
    Next

    With wsNDA
        Dim NR As Long, LR As Long, LC As Long
        Dim f As Range

        LR = .Range("C" & Rows.Count).End(xlUp).Row
        LC = .Cells(2, Columns.Count).End(xlToLeft).Column
        NR = LR + 1

        'find matching row if it exists
        Set f = .Range("A3:A" & LR).Find(what:=p.Cells(1).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            f.Resize(1, p.Cells.Count).Value = p.Value
        Else
            'what should happen if not found?
        End If
    End With

    Application.ScreenUpdating = True

End Sub
于 2012-05-02T23:42:35.307 に答える