多次运行时如何阻止宏重复？

Question

I have a macro that I hashed together with the immense help with other users on here. I then edited it slightly to fit my needs.

Right now, running the macro will have Excel look for any numerical value above 0 in column V of Sheet2. If a value above 0 exists, copy cells S:V of that same row. Then Excel will look for the last row that has data in it in column T and move to the next row after. Excel will then paste the data from cell S:V into this row. Afterwards, it will go back to Sheet2 and continue to look in column V for the next value that exists and do it all over again until it reaches the end of the column.

My issue is that when you run the macro twice, it will perform the actions as needed twice, resulting in duplicate values. I want Excel to perform the macro once and then if it is run again, have nothing happen. I'm trying to prevent human error in case someone accidentally runs the macro twice and doesn't notice it. Is this possible?

    Sub CopyPaste()

    Dim c As Range
    Dim IRow As Long, lastrow As Long
    Dim rSource As Range
    Dim wsI As Worksheet, wsO As Worksheet
    Dim endrow As Long


    On Error GoTo Whoa


    '~~> Sheet Where values needs to be checked
    Set wsI = ThisWorkbook.Sheets("Sheet2")
    '~~> Output sheet
    Set wsO = ThisWorkbook.Sheets("Sheet1")

    Application.ScreenUpdating = False

    'Look for last row with data in column T and move to next
    endrow = wsO.Cells(Rows.Count, "T").End(xlUp).Row + 1


    With wsI
        '~~> Find Last Row which has data in Col S to V
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then

            lastrow = .Columns("S:V").Find(What:="*", _
                          After:=.Range("S1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lastrow = 1
        End If


        Set rSource = .Range("V1:V" & lastrow)


            If IsNumeric(c.Value) Then
                If c.Value > 0 Then
                    wsO.Cells(endrow + IRow, 20).Resize(1, 4).Value = _
                         .Range("S" & c.Row & ":V" & c.Row).Value
                    wsO.Cells(endrow + IRow, 25).Value = "ID#" & .Range("J" & c.Row).Value
                    IRow = IRow + 1
                End If
            End If

        Next
    End With

 LetsContinue:
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    Exit Sub
 Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Answer 1

Another solution to prevent human error (more like a band-aid solution):

If MsgBox("Are you sure you want to run this macro? Running it a second time can result in duplicate values! Proceed?", vbYesNo + vbQuestion) = vbNo Then Exit Sub

Putting this at the start of your macro can warn the user against running it by accident.

Answer 2

As SJR mentioned why not clear the wsO before running the code again:

Sub CopyPaste()

Dim c As Range
Dim IRow As Long, lastrow As Long
Dim rSource As Range
Dim wsI As Worksheet, wsO As Worksheet
Dim endrow As Long


On Error GoTo Whoa


'~~> Sheet Where values needs to be checked
Set wsI = ThisWorkbook.Sheets("Sheet2")
'~~> Output sheet
Set wsO = ThisWorkbook.Sheets("Sheet1")

wsO.Rows("2:" & Rows.Count).ClearContents
'the above line will clear the sheet from Row 2 to the last (in case you have headers, if not then change 2 to 1

Application.ScreenUpdating = False

'Look for last row with data in column T and move to next
endrow = wsO.Cells(Rows.Count, "T").End(xlUp).Row + 1


With wsI
    '~~> Find Last Row which has data in Col S to V
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then

        lastrow = .Columns("S:V").Find(What:="*", _
                      After:=.Range("S1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastrow = 1
    End If


    Set rSource = .Range("V1:V" & lastrow)


        If IsNumeric(c.Value) Then
            If c.Value > 0 Then
                wsO.Cells(endrow + IRow, 20).Resize(1, 4).Value = _
                     .Range("S" & c.Row & ":V" & c.Row).Value
                wsO.Cells(endrow + IRow, 25).Value = "ID#" & .Range("J" & c.Row).Value
                IRow = IRow + 1
            End If
        End If


End With

LetsContinue:
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub