Excel - BUSCAR VALORES EN COLUMNAS Y COLOCARLOS EN FILAS POR RANGOS

Option Explicit

'//By JuanC - Mar. 2014

Sub test()

Dim off&, fil&

Dim rngPivot As Range, rngDst As Range

Dim vTo, vFrom, vName

Dim Color, vColor, colorFrom, colorTo

Color = -1

Set rngPivot = Range("B2")

Set rngDst = Range("D2")

off = 0

Range("D2:F100").Clear

Do While 1

   If Color <> rngPivot.Offset(off).Interior.Color Then

      If Color = -1 Then

         With rngPivot

              vFrom = .Offset(off).Value

              colorFrom = .Offset(off).Interior.Color

              vName = .Offset(off, -1).Value

              vColor = .Offset(off, -1).Interior.Color

         End With

      Else

          vTo = rngPivot.Offset(off - 1).Value

          colorTo = rngPivot.Offset(off - 1).Interior.Color

          With rngDst

               .Offset(fil, 0).Value = vName

               .Offset(fil, 0).Interior.Color = vColor

               .Offset(fil, 1).Value = vFrom

               .Offset(fil, 2).Value = vTo

               .Offset(fil, 1).Interior.Color = colorFrom

               .Offset(fil, 2).Interior.Color = colorTo

          End With

          With rngPivot

               vFrom = .Offset(off).Value

               colorFrom = .Offset(off).Interior.Color

               vName = .Offset(off, -1).Value

               vColor = .Offset(off, -1).Interior.Color

          End With

          fil = fil + 1

      End If

      Color = rngPivot.Offset(off).Interior.Color

   End If

   off = off + 1

   If VBA.Trim(rngPivot.Offset(off - 1).Value) = "" Then Exit Do

Loop

End Sub