「N」列に「Complete - Design」を含む「Projects Overview」というシートの行をコピーして別のシートに貼り付けるvbaコードがあります。これはしばらくの間正しく機能していましたが、今では行を複数回貼り付けます。貼り付けられた複製の数が、「プロジェクトの概要」シートで使用されている行の数と一致することがわかりました。コードは各行をループして実行しているだけだと思います。
これが私がこれまでに持っているものです:
Sub CompleteJob()
'Looks through the status column (N) of the Projects Overview table and moves them to Completed table, then deletes row from projects list
Dim Firstrow As Long
Dim lastRow As Long
Dim LrowProjectsOverview As Long
With Sheets("Projects Overview")
.Select
Firstrow = .UsedRange.Cells(1).Row
lastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For LrowProjectsOverview = lastRow To Firstrow Step -1
With .Cells(LrowProjectsOverview, "N")
If Not IsError(.Value) Then
If ((.Value = "Complete - Design") Or (.Value = "P4P") Or (.Value = "Ready for Setup")) Then .EntireRow.Copy Sheet3.Range("A200")
If Sheet9.Range("B2").Value = "" Then
Sheet9.Range("A2:Q2").Value = Sheet3.Range("A200:Q200").Value
Sheet3.Range("A200:Q200").ClearContents
Else
Sheet9.Range("B2").EntireRow.Insert
Sheet9.Range("A2:Q2").Value = Sheet3.Range("A200:Q200").Value
Sheet3.Range("A16:Q16").ClearContents
Sheet9.Range("B2:Q2").Interior.Color = xlNone
Sheet9.Range("B2:Q2").Font.Bold = False
Sheet9.Range("B2:Q2").Font.Color = vbBlack
Sheet9.Range("B2:Q2").RowHeight = 14.25
End If
If Sheet9.Range("B2").Value = "" Then
Sheet9.Range("B2").EntireRow.Delete
End If
If ((.Value = "Complete - Design") Or (.Value = "P4P") Or (.Value = "Ready for Setup")) Then .EntireRow.Delete
End If
End With
Next LrowProjectsOverview
End With
End Sub