Option Explicit
Sub test()
Dim c As Long, c2 As Long, l As Long
Application.ScreenUpdating = False
With Sheets("Base")
For l = 2 To Sheets("Archives").Range("C65536").End(xlUp).Row
For c = 14 To 194 Step 18
For c2 = 0 To 12 Step 2
Sheets("Archives").Cells(l, c + c2).Resize(, 2).Copy Destination:=.Range("B65536").End(xlUp)(2)
Next c2
Next c
Sheets("Archives").Cells(l, 3).Copy Destination:=.Range(.Range("A65536").End(xlUp)(2), .Range("B65536").End(xlUp).Offset(0, -1))
Next l
End With
Application.ScreenUpdating = True
End Sub