Excel 2010, vba copy row to another sheet exclude

2019-08-29 05:34发布

I have an excel workbook with a requirement to take rows from one sheet and copy (append) to another sheet based on the value within a column. I can accomplish this using the code below, but obviously each time I run this code, it will append the same rows over again.

i.e Sheet1 is constantly added to, sheet2 is an incremental log of all the rows in sheet1 that have a flag of Yes in column 13. Same columns on both sheets, column 1 is a unique ID.

Is there a way I can add to this code in order to make sure only rows from sheet1 that do not already appear in sheet2 are copied.

I cobbled the code below together from an answer to other questions posted here, but cannot seem to figure uot how to avoid duplicating rows in sheet2. Im not that advanced with VBA at all. Thanks in advance for any help.

 Sub GasImportToPending()
    Dim x As Long
    Dim iCol As Integer
    Dim MaxRowList As Long
    Dim S As String


    Set wsSource = Worksheets("sheet1")
    Set wsTarget = Worksheets("sheet2")

    iCol = 1
    MaxRowList = wsSource.Cells(Rows.Count, iCol).End(xlUp).Row

    For x = MaxRowList To 1 Step -1
        S = wsSource.Cells(x, 13)
        If S = "Yes" Or S = "yes" Then



            AfterLastTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1

            wsSource.Rows(x).Copy
            wsTarget.Rows(AfterLastTarget).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If
    Next

   Application.ScreenUpdating = True

End Sub

1条回答
仙女界的扛把子
2楼-- · 2019-08-29 05:55

Try the following. It uses the unique identifier in Column A and sees if it exists in Column A on Sheet2. If it does, it doesn't copy the row, otherwise it does.

Sub GasImportToPending()
    Dim x As Long
    Dim iCol As Integer
    Dim MaxRowList As Long
    Dim S As String
    Dim fVal As String
    Dim fRange As Range


    Set wssource = Worksheets("sheet1")
    Set wstarget = Worksheets("sheet2")

    iCol = 1
    MaxRowList = wssource.Cells(Rows.Count, iCol).End(xlUp).Row

    For x = MaxRowList To 1 Step -1
        S = wssource.Cells(x, 13)
        If S = "Yes" Or S = "yes" Then

            fVal = wssource.Cells(x, 1).Value

            Set fRange = wstarget.Columns("A:A").Find(What:=fVal, LookIn:=xlFormulas, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)

            If fRange Is Nothing Then

                AfterLastTarget = wstarget.Cells(Rows.Count, 1).End(xlUp).Row + 1

                wssource.Rows(x).Copy
                wstarget.Rows(AfterLastTarget).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If

        End If
    Next

   Application.ScreenUpdating = True

End Sub
查看更多
登录 后发表回答