Please be patient as I try to explain the dilemma. I am trying to write a macro that will help me sort the following table:

![enter image description here](https://i.stack.imgur.com/Yr280.png)

and trying to sort by sales ID into another worksheet(within the same workbook) with these pre-formatted tables:

![enter image description here](https://i.stack.imgur.com/teLPt.png)

End result should look like below image where all I need to do is fill in the sales ID and the formulas to the right of the sales ID column calculate or perform lookups:

![enter image description here](https://i.stack.imgur.com/CKzPS.png)

Problem is that my team has been filling the tables manually or using a combination of the sort function to fill in the tables manually. Problem is that this can be a pain when we have 10,000+ sales IDs and no automation. My attempt at coding this to help my team has not been helped by my limited vba knowledge - any assistance appreciated:

Edit: I made some modifications to Kelvin's code (thanks @kelvin!) and I want to clarify that all I want to do is paste special values those sales ID into my "Tables" tab based off of the positions of the pre-formatted table. See new image below as well as re-posed code. Note the formulas in my Tables tab without Sales IDs (my fault that I wasn't clear)

One last note: The last thing I am trying to solve to complete this is to scan two ranges and filter out the unique pairs into an array to make the array CFValues below dynamic - please help if you know how to do this better than me!

![enter image description here](https://i.stack.imgur.com/y94yn.png)

```
Option Explicit

Sub SortNCopy2TablesV2()

Dim CFValues As Variant

Dim r As Integer
Dim i As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim CombStr As Variant
Const startRow As Long = 7 'kelvin added

CFValues = Array("P A", "P B", "P C", "P F", "M A", "SP A", "SP B", "SP C")

Set ws1 = Worksheets("Cashflow")
Set ws2 = Worksheets("Tables")

r = startRow 'kelvin changed

'kelvin added
Application.ScreenUpdating = False
On Error Resume Next
For i = LBound(CFValues) To UBound(CFValues)
    Worksheets.Add
    ActiveSheet.Name = CFValues(i)
    If Err.Number = 1004 Then
        Application.DisplayAlerts = False
        Worksheets(CFValues(i)).Cells.Clear
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    End If
Next i
On Error GoTo 0

With ws1 'kelvin added

    Do Until .Range("C" & r).Value = ""

        CombStr = .Range("C" & r).Text + " " + .Range("D" & r).Text 'kelvin changed

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

            If StrComp(CombStr, CFValues(i), vbTextCompare) = 0 Then 'kelvin changed
                                    'kelvin added 1 lines of code:
                .Range("B" & r).Copy _
                        Worksheets(CFValues(i)).Range("B" & Application.WorksheetFunction.CountA(Worksheets(CFValues(i)).Range("B:B")) + 1)

            End If
        Next i
        r = r + 1
    Loop
End With

'kelvin added
Dim nextRow As Long
Dim tempRow As Long
Dim numRows As Long

nextRow = 5

For i = LBound(CFValues) To UBound(CFValues)
    tempRow = Application.WorksheetFunction.CountA(Worksheets(CFValues(i)).Range("B:B"))

    If tempRow > 0 Then

        numRows = Application.WorksheetFunction.CountA(Worksheets(CFValues(i)).Range("B:B"))

        ws2.Range("B" & nextRow + 1).EntireRow.Resize(numRows).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ws2.Range("C" & nextRow & ":" & "F" & nextRow + numRows).FillDown
        Worksheets(CFValues(i)).Range("B2").CurrentRegion.Copy ws2.Range("B" & nextRow + 1)
        ws2.Range("B" & nextRow + 2 + tempRow) = CFValues(i)
        nextRow = nextRow + tempRow + 5

    End If
Next i

Application.ScreenUpdating = True

End Sub

```