Copy columns from matching rows

Question

I have a spreadsheet containing 100 rows with country names and 12 columns (months of the year) containing values. My need is to compose a macro that: sweep the columns and copy to another spreadsheet so that the country is in column A, and the month value in column B one below the other. I appreciate the help.

Ex: column A - PARENTS | Column B - VALUE

Thank you in advance.

Answer 1

The macro below is a generic macro to transpose values that are organized in columns to rows.

Using as an example your question, where values are organized in columns of months:

País         Jan         Fev         Mar 
----------   ----------  ----------  ----------
Brasil       110,00      120,00      130,00 
Alemanha     210,00      220,00      230,00 

The macro will generate a resulting table where the months and their respective values are displayed online:

Pais        Mês  Valor 
----------  ---  ----------
Brasil      Jan  110,00 
Brasil      Fev  120,00 
Brasil      Mar  130,00 
Alemanha    Jan  210,00 
Alemanha    Fev  220,00 
Alemanha    Mar  230,00 

In your case the macro can be called as follows:

Transpor "Plan1", "A1:M101", "Plan2", "A1", "Mês", "Valor"

Macro to Transpose Columns in Rows

Public Sub Transpor(PlanilhaOrigem As String, IntervaloTabelaOrigem As String, _
                    PlanilhaDestino As String, CelulaDestino As String, _
                    Optional TituloValores1 As String = "Valor1", _
                    Optional TituloValores2 As String = "Valor2")

    Dim rangeTabelaOrigem As Range
    Dim rangeCelulaDestino As Range
    Dim lin As Integer
    Dim col As Integer
    Dim linDest As Integer

    'Definir o intervalo da tabela onde estão os dados de origem (incluindo cabeçalho)
    Set rangeTabelaOrigem = Worksheets(PlanilhaOrigem).Range(IntervaloTabelaOrigem)

    'Definir a célula onde inicia a tabela de destino
    Set rangeCelulaDestino = Worksheets(PlanilhaDestino).Range(CelulaDestino)

    'Montar o cabeçalho da tabela de destino
    rangeCelulaDestino.Value = rangeTabelaOrigem.Cells(1, 1)
    rangeCelulaDestino.Offset(, 1).Value = TituloValores1
    rangeCelulaDestino.Offset(, 2).Value = TituloValores2

    'Percorrer a tabela de origem e preencher a tabela de destino
    For lin = 2 To rangeTabelaOrigem.Rows.Count

        For col = 2 To rangeTabelaOrigem.Columns.Count

            linDest = linDest + 1

            rangeCelulaDestino.Offset(linDest).Value = rangeTabelaOrigem.Cells(lin, 1).Value
            rangeCelulaDestino.Offset(linDest, 1).Value = rangeTabelaOrigem.Cells(1, col).Value
            rangeCelulaDestino.Offset(linDest, 2).Value = rangeTabelaOrigem.Cells(lin, col).Value
        Next
    Next
End Sub