Search code examples
excelvbaparsingtranspose

Copy blocks of cells into rows?

I have a spreadsheet that has 2 columns of data. Within those 2 columns, there are repeating blocks of information that comprise contact records. There is a consistent pattern to them.

This is the pattern:

enter image description here

I'm looking for a way to copy this data into a new Excel tab with a row per contact record: Name, Address, Unit, Mutual, Phone Number

Does anyone know a way to do this, by function or macro?

Thanks!

Solution

  • This macro will do the trick. Just make sure that the sheet with your source data is active when you run it.

    Sub copy_data()
  Dim source As Worksheet
  Dim dest As Worksheet
  Dim r As Long
  Dim row As Long
  Set source = ActiveSheet
  Set dest = ThisWorkbook.Worksheets.Add
  dest.Cells(1, 1).Value = "Name"
  dest.Cells(1, 2).Value = "Address"
  dest.Cells(1, 3).Value = "Unit"
  dest.Cells(1, 4).Value = "Mutual"
  dest.Cells(1, 5).Value = "Phone Number"
  r = 1
  row = 1
  Do Until source.Cells(r, 1).Value = ""
    row = row + 1
    dest.Cells(row, 1).Value = source.Cells(r, 1).Value
    dest.Cells(row, 2).Value = source.Cells(r + 1, 1).Value
    dest.Cells(row, 3).Value = source.Cells(r + 1, 2).Value
    dest.Cells(row, 4).Value = source.Cells(r + 2, 1).Value
    dest.Cells(row, 5).Value = source.Cells(r + 2, 2).Value
    r = r + 3
  Loop
  
End Sub