Transpose web data from horizontal (rows) to vertical (columns)

Hye Excel Expert,

Attached is the sample of web data for transpose process. Generally, each portion is a group of data consists of the following parameters:-

Work Order ID
Submit Date
Submitter
Communication Source
View Access
Notes

The source data (web data) is in horizontal mode and every portion is separated by a line. If we see the pattern for the value for each parameter, each parameter only has 1 row value, EXCEPT parameter 'Notes' that may vary from 1 portion to another. However, I need the output to be as the following (with sample data):-

Work Order ID Submit Date Submitter Communication Source View Access Notes
WO0000000075830 *04/01/2018 7:47:35 PM *v04784x * Public * User ID have been created.refer attachment.TQ.

I have hundreds of web data files in a folder in local PC. I need a macro that can loop all web data files in the folder, transpose each portion from horizontal (rows) to vertical (columns) manner with the parameter names as the header which needs only to be published once in one master worksheet. I manage to find one macro that can transpose but the macro only limits to a fixed number of columns, which will not be applicable when the number of rows as values in parameter 'Notes' is consists of multiple rows (inconsistent number of rows).

Below is the macro I found that I think very close-relation to my problem.

Please Login or Register  to view this content.

Can anyone help me, please?

Tqvm in advance.
DZ

Cleared a duplicate …

First create a brand new workbook with one worksheet, create headers in row #1,
paste the below demonstration to the worksheet module Sheet1
then save the workbook in the parent folder of the web files folder
(in fact whatever as you can mod the path within the code) …

As a beginner starter to transpose from vertical to horizontal :

PHP Code: 

Sub Demo1()
          Dim L&, P$, F$, Rg As Range, R&
          Me.UsedRange.Offset(1).Clear
          Application.ScreenUpdating = False
          L = 1
          P = ThisWorkbook.Path & "\Sample Source Data\"
          F = Dir(P & "*.htm")
    While F > ""
        With Workbooks.Open(P & F).Worksheets(1).UsedRange.Columns(1)
               Set Rg = .Find("Work Order ID", , xlValues, xlWhole)
            If Not Rg Is Nothing Then
                    R = Rg.Row
                Do
                    With Rg.CurrentRegion.Rows
                       V = Application.Index(.Columns(2), [COLUMN(A:F)])
                       If .Count > 6 Then V(6) = Join(Application.Index(.Item("6:" & .Count).Columns(2), _
                                  Evaluate("COLUMN(" & [A1].Resize(, .Count - 5).Address & ")")), vbLf)
                    End With
                       L = L + 1
                       Cells(L, 1).Resize(, 6).Value = V
                       Set Rg = .FindNext(Rg)
                Loop While Rg.Row > R
            End If
               .Parent.Parent.Close False
        End With
          F = Dir
    Wend
          Set Rg = Nothing
          Application.ScreenUpdating = True
End Sub 


Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !