Add information that is per row in a column in excel

0

Good morning

My goal is to transpose these 2 lines into vba (in this case 6 lines)

That is, what I want is to repeat the whole information but then I just want to have a privileges column even if I have repeated all the rest of the information

DimcountprivilegiosAsIntegerDimlinhaAsIntegerDimcolunaprivilegioAsIntegerDimfolhaorigemAsStringDimfolhadestinoAsStringDimuserlinhaAsStringDimnomelinhaAsStringfolhaorigem="Extração Enterprise User InaAct"
folhadestino = "Extração Enter UsersInaActiv"
linhafolhaorigem = 2
colunaprivilegio = 18
userlinha = ""
nomelinha = ""

Do While linha <> ""

    Do While colunaprivilegio <> ""

        '(o que devo colocar aqui)
        imprimir folhaorigem, folhadestino, linhafolhaorigem
        colunaprivilegio = colunaprivilegio + 1
    Loop

    linha = linha + 1
Loop
    
asked by anonymous 21.11.2018 / 12:10

1 answer

0

As the danieltakeshi mentioned above, it takes more information for a more responsive answer. But here's a code I've done that can help with what you need:

Sub TrasporRangeSelection()

Dim vShtFonte As Worksheet
Dim vShtDestino As Worksheet
Dim vFonteLinhaInicio As Long
Dim vFonteColunaInicio As Long
Dim vFonteColunaFim As Long
Dim vFonteColunaPivo As Long
Dim vFonteRange As Range
Dim vResultSet As Variant
Dim i As Long

    Set vShtFonte = ThisWorkbook.Sheets("Fonte")
    Set vShtDestino = ThisWorkbook.Sheets("Destino")
    vFonteLinhaInicio = 2
    'ColunaPivo neste caso é uma coluna que vai sempre estar preenchido. nunca vai estar em branco qdo a linha estiver preenchida
    vFonteColunaPivo = 1
    vFonteColunaInicio = 5
    vFonteColunaFim = 10
    i = 0

    Do While vShtFonte.Cells(vFonteLinhaInicio, vFonteColunaPivo).Offset(i, 0).Value <> vbNullString

        Set vFonteRange = _
        vShtFonte.Range(vShtFonte.Cells(vFonteLinhaInicio + i, vFonteColunaInicio), _
                        vShtFonte.Cells(vFonteLinhaInicio + i, vFonteColunaFim))

        vResultSet = Application.Transpose(vFonteRange)

        If vShtDestino.Cells(2, 1).Value = vbNullString Then
            vShtDestino.Range(vShtDestino.Cells(2, 1), vShtDestino.Cells(2 + UBound(vResultSet, 1) - 1, 1)).Value = vResultSet
        Else
            vShtDestino.Range(vShtDestino.Cells(2, 1).End(xlDown).Offset(1, 0), vShtDestino.Cells(2, 1).End(xlDown).Offset(UBound(vResultSet, 1), 0)).Value = vResultSet
        End If
        i = i + 1
    Loop

End Sub
    
30.11.2018 / 13:35