Data in unuseable format

[cSciFiChick]

Hey guys I am trying to compare delivery shipping opens for different zip code pair and the ata is coming out in a format that I really can not use. I want to be able to see the zip code pair and all services that are available with all the other info.

Order #

Svc Code

Svc Desc

Guar Code

PU Date

PU Time

Dlv Date

Dlv Time

Dlv Day

Bus Trns Days

Tot Trns Days

Holidays

Delay Days

Rest Days

Cust Ctr Cutoff

Sat Dlv

Sat Dlv Disclaim for up to 10 Services

Svc Code

Svc Desc

1

Early AM

Morning Del

Y

04/18/18

05:00:00 PM

04/20/18

07:00:00 PM

Tue

1

1

x

x

x

05:00:00 PM

y

x

Next Day

Next Day

<colgroup><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"><col width="107"></colgroup> <tbody>
</tbody>

So the order is the zip code pair and I can potencially have thousands of thes. So as you see it does the Svc Code to Sat Dlv Disclaim for up to 10 services. Then it lists the next Svc Code. with the same sixteen columns of data. There are 10 possible services so those sixteen columns can be repeated 10 times. Anyway I would love a macro or something to move the data into a single sixteen columns and have it go down instead of across. For each different zip code pair. I can not figure out the best solution, a macro formulas..I just need help please.

Here is the google doc to show you what it looks like.

https://docs.google.com/spreadsheets/d/1WuHYu3lPukhkYEFj-ASODUIMBdPyraXW_6VV8f8m63Q/edit?usp=sharing

 

[Fluff]

How about

Sub SplitDatatoRows()
   Dim rws As Long
   Dim i As Long, j As Long, k As Long
   
   For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      rws = (Cells(i, Columns.Count).End(xlToLeft).Column - 1) / 16
      If rws > 1 Then
         j = 18
         Rows(i + 1).Resize(rws - 1).Insert
         Range("A" & i).Resize(rws).FillDown
         For k = 1 To rws - 1
            Cells(i, j).Resize(, 16).Copy Range("b" & k + i)
            j = j + 16
         Next k
      End If
   Next i
End Sub