Excel / VBA-根据位置将多行合并为一-如何检查单元格值，然后将值保存在另一个单元格中？

Question

My excel sheet has value of data in right cell so its like

+---+--------+---------------------+
|   |   A    |          B          |
+---+--------+---------------------+
| 1 | School | newyork high school |
| 2 | Head   | Mr john             |
| 3 | phone  | 0191919             |
| 4 | email  | john@school.com     |
+---+--------+---------------------+

School name in single cell then others data are next to the cell. I want to arrange them vertically like

+---+---------------------+---------+---------+-----------------+
|   |          A          |    B    |    C    |        D        |
+---+---------------------+---------+---------+-----------------+
| 1 | School              | Head    | Phone   | Email           |
| 2 | newyork high school | Mr john | 0191919 | john@school.com |
+---+---------------------+---------+---------+-----------------+

I am trying to get the value of next cell in following way.

Dim cell As Range
For Each cell In Range("a1:a40")
    If cell.Value = school Then
        Range("E3").Value = cell.Offset(1, 0).Value   
Next

Answer 1

It is somewhat unclear exactly what you are trying to accomplish, however, this should get you started:

Sub transposeCellData()
    Dim Rng As Excel.Range
    Dim cll As Excel.Range
    Dim schoolName As String
    Dim schoolHead As String
    Dim schoolAdd As String
    Dim schoolWeb As String
    Dim schoolPhone As String
    Dim schoolFax As String
    Dim outRow As Currency
    outRow = 2
    Set Rng = Range("A1:A40")
    For Each cll In Rng
        If ucase(trim(cll.Value)) = "HEAD:" Then
            schoolName = cll.Offset(-1, 0).Value
            schoolHead = cll.Offset(0, 1).Value
            schoolAdd = cll.Offset(1, 1).Value
            schoolWeb = cll.Offset(2, 1).Value
            schoolPhone = cll.Offset(1, 3).Value
            schoolFax = cll.Offset(2, 3).Value
            Range("I" & outRow).Value = schoolName
            Range("J" & outRow).Value = schoolHead
            Range("K" & outRow).Value = schoolAdd
            Range("L" & outRow).Value = schoolPhone
            Range("M" & outRow).Value = schoolFax
            Range("N" & outRow).Value = schoolWeb
            outRow = outRow + 1
        End If
    Next cll
End Sub

Let me know if that helps. +1