Copy columns of corresponding rows

Question

Copy columns of corresponding rows

Navigation

#1 by (0 votes)

1

I have a spreadsheet that contains 100 lines with country names and 12 columns (months of the year) containing values. My need is to compose a macro that: sweeps the columns and copies them to another worksheet so that the country stays in column A, and the value of the month in column B one below the other. Thanks for the help.

Ex: column A - COUNTRY | Column B - VALUE

Thank you in advance.

macro excel vba

asked by anonymous 22.11.2017 / 17:00

1 answer

focus on input loaded via ajax 8000 character limit in ASP Classic / SQL server

score 0 · Accepted Answer

The macro below is a generic macro for transposing values that are organized into columns for rows.

Using your question as an example, where values are arranged 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 will be 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