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