Fixed Range Macro Problem

Asked

Viewed 124 times

0

I created a macro to select cell information from a dynamic table and copy to a new table.

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

My problem is that with this code I can only copy the information of the cells that are in range (A3:B5) and would like to be able to do it with any cells of a range that I select and not just on range (A3:B5). By which term should I replace the cells of the range (A3:B5) so that the selected cells can be rotated in the macro instead of a fixed interval, as in the case A:B5?

In case you couldn’t make me understand, I can try explaining again. I have this problem that has made me very difficult with data processing.

1 answer

0

Browser other questions tagged

You are not signed in. Login or sign up in order to post.