Creating A Spreadsheet from a Complex CSV file

After 10 posts here you should know that...

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.



Make the title more descriptive of the problem and I'm sure we'll be able to help you out.

I uploaded a second sample with the end result desired. I couldn't figure out how to delete the first spreadsheet.
These are the values that I'll be working with. The actual file contains 59 columns. Didn't think that putting all that info in would make a difference, and just make it harder to understand what I was wanting.

So are you ignoring the other columns, and only trying to extract information from the ones you've mentioned?

Well, assuming that you are ... this code is a bit hacky, but should do what you want.

However, it does assume that each shipment has "FRT" in the first row of the shipment info in column B - is this always the case?

Sub TransferInfo()

Const sSEARCH_FOR As String = "FRT"
Const lFIRST_HEADER_COL As Long = 5
Const lSEARCH_COL As Long = 2

Dim wshTarget As Worksheet
Dim wshSource As Worksheet
Dim rngMatch As Range
Dim rngWrite As Range
Dim vHeaders As Variant
Dim sFirst As String

vHeaders = Array("Freight discount amount", "Billed Freight", "Published charge", "Published fuel surcharge", "Billed fuel surcharge")

Set wshSource = ActiveSheet

'Create new workbook and add headers
Set wshTarget = Sheets.Add(after:=Sheets(Sheets.Count))
wshTarget.Cells(1, lFIRST_HEADER_COL).Resize(1, UBound(vHeaders) + (1 - LBound(vHeaders))).Value = vHeaders
Set rngWrite = wshTarget.Cells(2, 1)

Set rngMatch = wshSource.Columns(lSEARCH_COL).Find(sSEARCH_FOR, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True, after:=wshSource.Cells(Rows.Count, lSEARCH_COL).End(xlUp))

If Not rngMatch Is Nothing Then
  sFirst = rngMatch.Address
  Do
    rngWrite.Resize(1, 4).Value = rngMatch.EntireRow.Cells(1).Resize(1, 4).Value
    rngWrite.Offset(0, 4).Value = rngMatch.Offset(0, 8).Value
    rngWrite.Offset(0, 5).Value = rngMatch.Offset(0, 9).Value
    rngWrite.Offset(0, 6).Value = rngMatch.Offset(1, 5).Value
    rngWrite.Offset(0, 7).Value = rngMatch.Offset(1, 8).Value
    rngWrite.Offset(0, 8).Value = rngMatch.Offset(1, 9).Value
    Set rngMatch = wshSource.Columns(lSEARCH_COL).FindNext(rngMatch)
    Set rngWrite = rngWrite.Offset(1)
  Loop Until rngMatch.Address = sFirst
End If

End Sub