How to fill an Array with values from Range of cells, skip cells then add more values.

I have 2 workbooks, Array Source and Array Destination, right now the button (Create Purchase Request) in Array source will look at a the values in column R, and fill an Array (C to K) based on that value. Then insert that Array of Data into the Array Destination workbook. I would like to take the current Array of values but then skip columns and include column S in the Array. The Array destination workbook will get populated in columns C to K but then the added value from the S column will be in the X column. The code I that I am currently using is listed below.

    Set ws1 = ThisWorkbook.Sheets("Parts Summary")
    Set wb2 = Workbooks.Open(fpath)                                             'Open the Purchase Request Template in SharePoint
    Set ws2 = wb2.Sheets("Purchase Req")
            ws2.Range("C10:K335").ClearContents
            ws2.Range("X10:X335").ClearContents
    Set ws3 = ThisWorkbook.Sheets("Legend Plates")
    Set ws4 = wb2.Sheets("Legend Plates")
        ws4.Range("A13:A112").ClearContents
        ws4.Range("C13:M112").ClearContents
    Set R1 = ws1.Range("C10:K344")
    Set R2 = ws2.Range("C10:K344")
    Set R3 = ws3.Range("A13:M132")
    Set R4 = ws4.Range("A13:M132")
    PRNum = ws1.Range("PSPRNo") + 1
'    ws1.Activate

    PSLastRow = ws1.Range("R" & ws1.Rows.Count).End(xlUp).Row
    DataArr = ws1.Range("C10:R" & PSLastRow).Value
    DataArr2 = ws1.Range("C10:T" & PSLastRow).Value
    OrderCnt = Application.CountIf(ws1.Range("R:R"), "Ready to Order")

    For Rw = LBound(DataArr, 1) To UBound(DataArr, 1)

        If DataArr(Rw, 16) = "Ready to Order" Then 'If the status column = Ready to Order

            If IsArray(TData) Then
                ReDim Preserve TData(8, UBound(TData, 2) + 1)
                For i = 0 To 8
                    TData(i, UBound(TData, 2)) = DataArr(Rw, i + 1)
                Next
            Else
                ReDim TData(8, 0)
                For i = 0 To 8
                    TData(i, 0) = DataArr(Rw, i + 1)
                Next
            End If
        End If
        If DataArr(Rw, 16) = "Return" And DataArr2(Rw, 18) = "" Then
            If IsArray(TData) Then
                ReDim Preserve TData(8, UBound(TData, 2) + 1)
                For i = 0 To 8
                    TData(i, UBound(TData, 2)) = DataArr(Rw, i + 1)
                Next
            Else
                ReDim TData(8, 0)
                For i = 0 To 8
                    TData(i, 0) = DataArr(Rw, i + 1)
                Next
            End If
        End If
        
   Next Rw

If IsEmpty(TData) Then
    MsgBox "There are no items marked as Ready to Order, please set the Line Item status for each item you want on the current purchase request to continue"
    wb2.Close
    Exit Sub
End If

    PRLastRow2 = ws2.Range("C" & ws2.Rows.Count).End(xlUp).Row + 1
    
    ws2.Range("C" & PRLastRow2).Resize(UBound(TData, 2) + 1, 9).Value = Application.Transpose(TData)
          
    With ws1

        'Set the first and last row to loop through
        PSFirstrow = 10
        PSLastRow = Cells(.Rows.Count, "R").End(xlUp).Row
        
        'loop from Lastrow to Firstrow (bottom to top)
        For PSLrow = PSLastRow To PSFirstrow Step -1

            With .Cells(PSLrow, "R")

                If Not IsError(.Value) Then

                    If .Value = "Ready to Order" Then
                        .Value = "Requested"
                        .Offset(, 2).Value = PRNum
                    End If
                    If .Value = "Return" And .Offset(, 2) = "" Then
                        .Offset(, 2).Value = PRNum
                    End If

                End If

            End With

        Next PSLrow

    End With