0

Criei uma macro para selecionar informações de células de uma tabela dinâmica e copiar para uma nova tabela.

Sub tabela_tratada_3_var()

'

' tabela_tratada_3_var Macro

'



'

    Range("D1").Select

    ActiveCell.FormulaR1C1 = "Respostas"

    Range("E1").Select

    ActiveCell.FormulaR1C1 = "Valores Absolutos"

    Range("F1").Select

    ActiveCell.FormulaR1C1 = "Valores Relativos"

    Range("A3:A5").Select

    Selection.Copy

    Range("D2:D4").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Range("B3:B5").Select

    Application.CutCopyMode = False

    Selection.Copy

    Range("E2:E4").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Range("D5").Select

    Application.CutCopyMode = False

    ActiveCell.FormulaR1C1 = "Total"

    Range("E5").Select

    ActiveCell.FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"

    Range("F2").Select

    ActiveCell.FormulaR1C1 = "=(RC[-1]/R5C5)"

    Range("F2").Select

    Selection.Style = "Percent"

    Selection.NumberFormat = "0.0%"

    Selection.NumberFormat = "0.00%"

    Selection.AutoFill Destination:=Range("F2:F4"), Type:=xlFillDefault

    Range("F2:F4").Select

    Range("F5").Select

    ActiveCell.FormulaR1C1 = ""

    Range("E5").Select

    Selection.AutoFill Destination:=Range("E5:F5"), Type:=xlFillDefault

    Range("E5:F5").Select

    Range("F7").Select

    Selection.Style = "Percent"

    Range("F5").Select

    Selection.Style = "Percent"

    Range("D1:F1").Select

    Selection.Font.Bold = True

    With Selection

        .HorizontalAlignment = xlGeneral

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Range("D1:F5").Select

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeTop)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlEdgeRight)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideVertical)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Borders(xlInsideHorizontal)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    With Selection.Font

        .Name = "Times New Roman"

        .Size = 10

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    With Selection.Font

        .Name = "Times New Roman"

        .Size = 12

        .Strikethrough = False

        .Superscript = False

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .ThemeFont = xlThemeFontNone

    End With

    Range("E2:F5").Select

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

    Range("E12").Select

End Sub

Meu problema é que com este código eu somente consigo copiar as informações das células que estão no range (A3:B5) e gostaria de poder fazê-la com quaisquer células de um range que eu selecionar e não apenas no range (A3:B5). Por qual termo devo substituir as células do range (A3:B5) para que possa ser rodado na macro as células selecionadas e não de um intervalo fixo, como no caso A:B5?

Caso não tenha conseguido me fazer entender, posso tentar explicar novamente. Estou com este problema que tem me dificultado muito com o tratamento de dados.

0

1 Resposta 1

0

Utilize o Selection, que utiliza as células selecionadas. Com Selection.Copy você está copiando as células selecionadas (pode ser manualmente, antes de execuar a macro).

Mas tente evitar o uso de .Select/.Activate/Selection/Activecell/Activesheet/Activeworkbook, você pode substituir pela última célula preenchida naquela coluna ou algum outro critério.

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .