Цель: У меня есть ряд результатов, появляющихся в следующей пустой строке для столбцов A, B и D (скриншот ниже). Для столбца C я хотел бы создать функцию, которая для каждого результата в столбце A говорит (из моего кода), что столбец C просто вставляет «Прерывание работы».

Мой текущий код выглядит следующим образом :
Sub Calc_Parish()
'Calculates the Parish for AICOW
Dim RPDataTbl As ListObject
Dim parishCol As ListColumn, AICOWcol As ListColumn
Dim copyRng As Range
Set RPDataTbl = Sheets("Risk Partner Data").ListObjects("RPdata")
With RPDataTbl
Set parishCol = .ListColumns("Parish & Code")
Set AICOWcol = .ListColumns("AICOW")
.Range.AutoFilter Field:=AICOWcol.Index, Criteria1:="TRUE"
End With
On Error Resume Next
Set copyRng = parishCol.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not copyRng Is Nothing Then
copyRng.Copy
With Sheets("Calc Data")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End If
RPDataTbl.Range.AutoFilter Field:=AICOWcol.Index
End Sub
Sub Calc_Buildno()
' Calculates the Build # for AICOW
Dim RPDataTbl As ListObject
Dim BuildnoCol As ListColumn, AICOWcol As ListColumn
Dim copyRng As Range
Set RPDataTbl = Sheets("Risk Partner Data").ListObjects("RPdata")
With RPDataTbl
Set BuildnoCol = .ListColumns("Building ID 1")
Set AICOWcol = .ListColumns("AICOW")
.Range.AutoFilter Field:=AICOWcol.Index, Criteria1:="TRUE"
End With
On Error Resume Next
Set copyRng = BuildnoCol.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not copyRng Is Nothing Then
copyRng.Copy
With Sheets("Calc Data")
.Cells(.Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End If
RPDataTbl.Range.AutoFilter Field:=AICOWcol.Index
' Need to add here the Insured Asset (Column C) as Business Interruption
End Sub
Sub Calc_Cresta()
' Calculates Cresta for AICOW
Dim RPDataTbl As ListObject
Dim CrestaCol As ListColumn, AICOW As ListColumn
Dim copyRng As Range
Set RPDataTbl = Sheets("Risk Partner Data").ListObjects("RPdata")
With RPDataTbl
Set CrestaCol = .ListColumns("Cresta")
Set AICOWcol = .ListColumns("AICOW")
.Range.AutoFilter Field:=AICOWcol.Index, Criteria1:="TRUE"
End With
On Error Resume Next
Set copyRng = CrestaCol.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not copyRng Is Nothing Then
copyRng.Copy
With Sheets("Calc Data")
.Cells(.Rows.Count, "D").End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End If
RPDataTbl.Range.AutoFilter Field:=AICOWcol.Index
End Sub
Я понимаю, что мой код громоздкий, но я не знаю, как его упростить, поэтому оставляю его как есть. Может ли кто-нибудь помочь? Спасибо.