Sub ParsePDFData()
Application.ScreenUpdating = False
With ActiveDocument.Range
  .Paragraphs.First.Range.Delete
  .Paragraphs.First.Range.Text = "Code" & vbTab & "Product" & vbTab & "Size" & vbTab & "Sales Start" & vbTab & "Sales End" & vbTab & "Price" & vbTab & "Old Price" & vbCr
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchWildcards = True
    .Text = "^13[!^13]@^13[!^13]@^13[!^13]@^13^12^13[!^13]@^13"
    .Replacement.Text = "^p"
    .Execute Replace:=wdReplaceAll
    DoEvents
    .Text = "[ ]{1,}^13"
    .Execute Replace:=wdReplaceAll
    .Text = "^13{2,}"
    .Execute Replace:=wdReplaceAll
    DoEvents
    .Text = "^13[0-9]{1,2}/[0-9]{1,2}/[0-9]{4} Page [0-9]{1,4}*notice.^13"
    .Replacement.Text = ""
    .Execute Replace:=wdReplaceAll
    .Text = "(^13)([A-Z][!^13]@)^13([A-Z0-9][!$^13]@)^13([0-9]{1,}) ([!$]@$[0-9.]{4,}>)"
    .Replacement.Text = "\1\4 \2 \3 \5"
    .Execute Replace:=wdReplaceAll
    DoEvents
    .Text = "(^13[0-9]{1,}>)([!$]@)($[!^13]{1,})"
    .Replacement.Text = "\1^t\2^t^t^t^t\3"
    .Execute Replace:=wdReplaceAll
    DoEvents
    .Text = "([0-9]{1,2}/[0-9]{1,2}/[0-9]{2,4}) ([0-9]{1,2}/[0-9]{1,2}/[0-9]{2,4}) ^t^t^t"
    .Replacement.Text = "^t^t\1^t\2"
    .Execute Replace:=wdReplaceAll
    DoEvents
    .Text = "(EACH )(^t)"
    .Replacement.Text = "\2\1"
    .Execute Replace:=wdReplaceAll
    .Text = "([0-9.]{2,5}[ ML]{2,4})(^t)"
    .Execute Replace:=wdReplaceAll
    DoEvents
    .Text = "($[0-9.]{4,}) ($[!^13]{1,})"
    .Replacement.Text = "\1^t\2"
    .Execute Replace:=wdReplaceAll
    DoEvents
    .Text = "^t[ ]{1,}"
    .Replacement.Text = "^t"
    .Execute Replace:=wdReplaceAll
    .Text = "[ ]{1,}^t"
    .Execute Replace:=wdReplaceAll
    DoEvents
  End With
  .Copy
End With
Call Export
Application.ScreenUpdating = True
End Sub
 
Sub Export()
Dim xlApp As Object, xlWkBk As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
  .Visible = True
  .ScreenUpdating = False
  Set xlWkBk = .Workbooks.Add
  With xlWkBk.Sheets(1)
    .Range("A1").PasteSpecial Paste:=-4163 'xlPasteValues
    .Columns.AutoFit
    .Columns("A:A").ColumnWidth = 8
    .Range("A2").Select
    .Columns("C:C").HorizontalAlignment = xlRight
  End With
  With .ActiveWindow
      .SplitColumn = 0
      .SplitRow = 1
      .FreezePanes = True
  End With
  .ScreenUpdating = True
End With
Set xlWkBk = Nothing: Set xlApp = Nothing
End Sub