The fastest way to loop in 2 tables

Try:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, Rng As Range, RngList As Object, srcWS As Worksheet, item As Variant
    Set srcWS = Sheets("Source")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each Rng In srcWS.Range("A2:A" & LastRow)
        If Not RngList.Exists(Rng.Value) Then
            RngList.Add Rng.Value, Nothing
        End If
    Next Rng
    For Each item In RngList
        With srcWS.Cells(1).CurrentRegion
            .AutoFilter 1, item
            Range("C2:C" & LastRow).SpecialCells(xlCellTypeVisible).Copy
            Sheets(item).Cells(2, 1).PasteSpecial Transpose:=True
        End With
    Next item
    srcWS.Cells(1).AutoFilter
    Application.ScreenUpdating = True
End Sub

Hi !

In this case you may use an advanced filter - Excel basics ! - which can copy only by headers whatever their destination order
and that needs a single codeline …

Has your problem been solved? If not, you can simply insert some code at the beginning of the macro to sort the "Source" sheet by column B in ascending order.