jeudi 1 avril 2021

Copy sheet once only when condition met then delete the sheet

I have multiple sheets and would like to copy the sheet to another workbook when a condition is met. The condition is comparing the value in cell through column Abs(R & lRow +2) to column AC & lRow + 3. As long as there is one comparison that meets the criteria, the sheet is copied. My current code would copy the sheet N times if the condition is met N times within comparisons of one sheet. Is there any suggestion on how to prevent this and only copy once? Also, I added sh.delete after copying but this would make the macro copy 1 sheet then stop working. An error message "Automation error' is received. Any suggestion on this issue? Thank you in advance for any help or suggestion!

Sub TES_copy()
Const ProcName As string = "TES_copy"
On Error GoTo clearError

Dim wb As Workbook: Set wb = Workbooks("A.xlsx")
Dim TESwb As Workbook: Set Teswb = Workbooks("B.xlsx")
Dim sh As Worksheet
Dim sCount As Long
Dim lRow As Long
Dim i As Long
Dim ColArray As Variant

Application.ScreenUpdating = False

For Each sh In wb.Worksheets
  lRow = sh.Cells(sh.Rows.Count,1).End(xlUp).Row
  ColArray = Array("R","S","T","U","V","W","X","Y","Z","AA","AB","AC")

  For i = LBound(ColArray) To UBound(ColArray)

  If Abs(sh.Range(ColArray(i) & lRow + 2)) > sh.Range(ColArray(i) & lRow +3) Then
    sCount = sCount + 1
    sh.Copy After:=TESwb.Sheets(TESwb.Sheets.Count)
  End If

  Next i

  Next sh

ProcExit:
  If Not Application.ScreenUpdating Then
     Application.ScreenUpdating = True  
  End If

  Select Case sCount
  Case 0 
    MsgBox "No worksheets copied.", vbExclamation, "Fail?"
  Case 1
    MsgBox "Copied 1 worksheet.", vbInformation, "Success"
  Case Else
    MsgBox "Copied " & sCount & " of A worksheets to B workbook.", vbInformation, "Success"
  End Select

clearError:
  Debug.Print "'" & ProcName & "':Unexpected Error!" & vbLf & " " & "Run-time error'" & Err.Number & "':";vbLf & " " & Err.Description
  Resume ProcExit

End Sub

Aucun commentaire:

Enregistrer un commentaire