Excel 2010, vba copy row to another sheet exclude previously copied based on ID number

佐手、 提交于 2019-12-12 03:39:06

问题


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:


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


来源:https://stackoverflow.com/questions/37327727/excel-2010-vba-copy-row-to-another-sheet-exclude-previously-copied-based-on-id

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!