Help reformatting block data into standard columns

I have a workbook with 26 worksheets full of address information in block format in 2 columns. Column A has the labels and column B has the data, looking something like the below:

Column A Column B
1.Name Acme Corp
Address 123 Main St
Phone # 555.867.5309

2.Name Widgets, Etc...
Address 1600 Pennsylvania Ave
Phone# 555.555.1212

I have about 100 addresses on each worksheet in the above format. I'd like to get all this information onto one page with column headers for name, address, phone, etc...

I can get the names into a list fairly easily using vlookup, because they have unique identifiers, 1.name, 2.name, 3.name, etc...but the rest of the labels in column 1 are not unique. Any thoughts on how to approach reformatting this workbook?

Thanks,
Dylan

I can write a quick macro to do it, are those your only three fields? If you post ALL the needed matching fields this would be a quick macro.

Is field 1 really 1.Name, then 2.Name, 3.Name, etc.?

As i said this is a pretty quick macro. You implied the data was in a set form, and your post hinted there might be a blank space between each set of 3 rows making up a data set. This macro assumes the data starts on row ONE on each sheet.

Option Explicit

Sub CollateContacts()
Dim LR As Long, NR As Long, i As Long
Dim ws As Worksheet, wsM As Worksheet

Set wsM = Sheets("Master")
NR = 2
On Error Resume Next

    For Each ws In Worksheets
        If ws.Name <> wsM.Name Then
            LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row - 2
            
            For i = 1 To LR Step 4
                ws.Range("B" & i, "B" & i + 2).Copy
                wsM.Range("A" & NR).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=True
                NR = NR + 1
            Next i
        End If
    Next ws

wsM.Columns("A:D").AutoFit
End Sub

Create a blank sheet called "Master", put the Name, Address, Phone headers in row 1, then run this macro.

If there is NOT a blank row between each set of data, then change the RED part to "Step 3"

JBeaucaire, thank you very much for your prompt response. I was unfortunately a bit incomplete in my original post in an attempt to simplify what I was trying to do. The data is mostly in a set form, but all fields are not available for all companies, and when they are not there the row is omitted. So the first company might be 12 rows worth of data, and the second company will have 10 rows of data. Also, the address is spread out on 3,4,or 5 rows, but only the first address row will have a label, so it will look like this

Column A Column B
Address 1234 1st St
New York, NY 10001
USA

I don't understand macros very well, but I think that what yours is doing is assuming that there would always be just the 3 pieces of data?

Edited to upload sample file

And your sample layout of what you want your master sheet to be? Layout the exact columnar format as I will create a macro to fill it in based on your design.

You can add a second sheet to the one you uploaded if you wish...name it something like Contacts.

This should do it. I removed the one column that collated nothing but dashes, so there are 7 columns total now.

Option Explicit

Sub CollateContacts()
Dim LR As Long, NR As Long
Dim cell As Range, RNG As Range
Dim ws As Worksheet, wsM As Worksheet

Set wsM = Sheets("Contacts")
NR = wsM.Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
Application.ScreenUpdating = False

    For Each ws In Worksheets
        If ws.Name <> wsM.Name Then
            ws.Activate
            LR = Range("B" & ws.Rows.Count).End(xlUp).Row
            Set RNG = Range("A1:A" & LR)
            
            For Each cell In RNG
                If InStr(1, cell, ".Na") > 0 Then
                    NR = NR + 1
                    wsM.Cells(NR, "A").Value = cell.Offset(0, 1).Value
                End If
                If InStr(1, cell, "Registration N") > 0 Then _
                    wsM.Cells(NR, "B").Value = cell.Offset(0, 1).Value
                If InStr(1, cell, "Registration D") > 0 Then _
                    wsM.Cells(NR, "C") = cell.Offset(0, 1).Value
                If InStr(1, cell, "Addr") > 0 Then _
                    wsM.Cells(NR, "D") = cell.Offset(0, 1).Value
                If InStr(1, cell, "Country") > 0 Then _
                    wsM.Cells(NR, "F") = cell.Offset(0, 1).Value
                If InStr(1, cell, "Telepho") > 0 Then _
                    wsM.Cells(NR, "G") = cell.Offset(0, 1).Value
                If cell = "" And cell.Offset(-1, 0) Like "Addr*" Then _
                    wsM.Cells(NR, "E") = cell.Offset(0, 1).Value
            Next cell
        End If
    Next ws
    
Application.ScreenUpdating = True
wsM.Activate
wsM.Columns("A:G").AutoFit
End Sub

I had never used the InStr() function myself, so your issue and the mildly varying nature of your data and match strings made that the only way to make it work.

If that takes care of your need, be sure to EDIT your original post, click Go Advanced and mark the PREFIX box [SOLVED].



(Also, use the "scales" icon in our posts to leave Reputation Feedback, it is appreciated)