Loop with an if Statement

[MrPink1986]

Hi,
At the min I have created the below sub which creates the data in the format which I require overall. However I would now like to split this data up in the loop based on criteria below into 4 different tabs based on the outcome of the statement. At the min the entire data is pasted on the Output tab.

I would like to add a new formula in the text tab for this purpose =MID(B3,20,6)
There are 4 outcomes in this formula

INTRAA
INTRAB
CLOSEA
CLOSEB

If the outcome is INTRAA these results should go into the tab of the same name and so forth.
Is it possible to include this in the code below to add the formula and then based on the value returned apply the copy and paste loop?

Sub TransposeData()   Dim Ws As Worksheet
   Dim Cl As Range
   Dim LR As Long
    
   Application.ScreenUpdating = False
    
   LR = Worksheets("Input").Range("A" & Rows.Count).End(xlUp).Row
   With Worksheets("macro")
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
        If LR > 2 Then .Range("A3").Resize(LR - 2, 25).ClearContents
        LR = Worksheets("Input").Range("A" & Rows.Count).End(xlUp).Row
        .Range("A2").Resize(LR - 1, 25).FillDown
        .Calculate
   End With
         
   Set Ws = Sheets("Text")
   Sheets("macro").UsedRange.Offset(1).Copy
   Ws.Range("A2").PasteSpecial xlPasteValues
   With Sheets("Output")
      For Each Cl In Ws.Range("A3", Ws.Range("A" & Rows.Count).End(xlUp))
         Range(Cl, Cl.End(xlToRight)).Copy
         .Range("A" & Rows.Count).End(xlUp).Offset(2).PasteSpecial , , , True
      Next Cl
   End With
   
   Sheets("Output").Select
   x = Sheets("macro").Range("R1")
   
   Cells(Rows.Count, "A").End(xlUp).Offset(2).Select
   ActiveCell.FormulaR1C1 = "EOD-OF-DATA|" & x
   
   
   Application.ScreenUpdating = True
   Range("A1").Select
   
   ActiveCell.FormulaR1C1 = "VERSION=1.0"
   ActiveCell.Offset(1).Select
   ActiveCell.FormulaR1C1 = "START-OF-DATA"
   Rows("3:3").Select
   Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   Range("A1").Select
     
    Call DeleteEmptyTenors
   
   MsgBox "This is now complete!" & vbNewLine & "There have been " & x & " records created."
      
End Sub