Skip to main content

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

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

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

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

O 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 no macro as células selecionadas e não de um intervalo fixo, como no caso A:B5.

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

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

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.

adicionou 1012 caracteres ao conteúdo
Fonte Link
NoobSaibot
  • 9,8mil
  • 6
  • 29
  • 53

Olá!

Peço ajuda, por favor, para resolver algo que não estou conseguindo resolver sozinho. Criei um macro para selecionar informações de células de uma tabela dinâmica e copiar para uma nova tabela. Segue o código:

Sub tabela_tratada_3_var()

'

' tabela_tratada_3_var Macro

'

'

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

End Sub

Aguardo um retorno e

Desde já agradecido!

Olá!

Peço ajuda, por favor, para resolver algo que não estou conseguindo resolver sozinho. Criei um macro para selecionar informações de células de uma tabela dinâmica e copiar para uma nova tabela. Segue o código:

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

Aguardo um retorno e

Desde já agradecido!

Criei um 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
Fonte Link

Problema com Range Fixo no Macro

Olá!

Peço ajuda, por favor, para resolver algo que não estou conseguindo resolver sozinho. Criei um macro para selecionar informações de células de uma tabela dinâmica e copiar para uma nova tabela. Segue o código:

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

O 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 no macro as células selecionadas e não de um intervalo fixo, como no caso A:B5.

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

Aguardo um retorno e

Desde já agradecido!