Boa tarde Fredson

Acesse o link e assista a uma vídeo aula e,tem até uma planilha para baixar de exemplo:

http://www.escolaexcel.com.br/2011/10/t ... lunas.html

Um abraço.

Boa noite!!

Tente

Sub Traspor_Dados_Colunas_Para_Linhas()
Dim sh As Worksheet, rng As Variant, comb As Range
Set sh = Sheets(1)
For i = 2 To 4
    lr = sh.Cells(Rows.Count, i).End(xlUp).Row
    With sh
        Set rng = .Range(.Cells(2, i), .Cells(lr, i))
    End With
        rng.Cut sh.Cells(Rows.Count, 1).End(xlUp)(2)
Next
Application.CutCopyMode = False
End Sub

Boa noite!!

Tente assim

Sub Traspor_Dados_Colunas_Para_Linhas()
Dim sh As Worksheet, rng As Variant, comb As Range
Set sh = Sheets(1)
For i = 2 To 4
    lr = sh.Cells(Rows.Count, i).End(xlUp).Row
    With sh
        Set rng = .Range(.Cells(1, i), .Cells(lr, i))
    End With
        rng.Cut sh.Cells(Rows.Count, 1).End(xlUp)(2)
Next
Application.CutCopyMode = False
End Sub

Para ler mais sobre VBA:
http://www.bertolo.pro.br/FinEst/Semana ... oExcel.pdf

Att

Jeitinho super fácil, sem VBA, só fórmulas...