Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Uma Macro para Toda...
 
Notifications
Clear all

Uma Macro para Todas as Planilhas

 
2024 - VBA & Macros
Post Recente por ghuto_lima 10 anos atrás
5 Posts
2 Usuários
0 Reactions
1,225 Visualizações
RSS
 ghuto_lima
(@ghuto_lima)
Posts: 70
Estimable Member
Topic starter
 

Ola Pessoal,
Bom dia.

Gostaria de saber como faço para executar a Macro abaixo para todas as planilhas que tenho no arquivo, independente do nomes das Plans.
Percebam que em algumas linhas, a Macro informa o nome da Plan (01.04.2015), só que esse arquivo terá varias planilhas com nomes diferentes, e quero executar essa Macro em todas elas.

É uma Macro de formatação.

Sub arrumar()
'
' arrumar Macro
'

'
    Selection.CurrentRegion.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Font.Bold = True
    Selection.CurrentRegion.Select
    ActiveWorkbook.Worksheets("01.04.2015").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("01.04.2015").Sort.SortFields.Add Key:=Range( _
        "F2:F27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("01.04.2015").Sort.SortFields.Add Key:=Range( _
        "H2:H27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("01.04.2015").Sort.SortFields.Add Key:=Range( _
        "G2:G27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("01.04.2015").Sort
        .SetRange Range("A1:H27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("H1").Select
    Selection.End(xlDown).Select
    Range("H28").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-26]C:R[-1]C)"
    Columns("H:H").Select
    Selection.NumberFormat = "$ #,##0.00"
    Range("A1").Select
    Selection.CurrentRegion.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
    Range("H1").Select
    Selection.End(xlDown).Select
    Selection.Font.Bold = True
    Range("G28").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Clear
    Selection.End(xlUp).Select
    Selection.End(xlUp).Select
    Selection.End(xlToLeft).Select
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.End(xlUp).Select
End Sub

Obrigado.

_________
Gustavo

 
Postado : 02/04/2015 7:48 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Tenta assim:

Sub arrumar()
Dim sht As Worksheet

    For Each sht In ThisWorkbook.Worksheets
        sht.Select
        Selection.CurrentRegion.Select
        With Selection
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Range("A1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Font.Bold = True
        Selection.CurrentRegion.Select
        With sht
            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=.Range("F2:F27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Sort.SortFields.Add Key:=.Range("H2:H27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Sort.SortFields.Add Key:=.Range("G2:G27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        With sht.Sort
            .SetRange Range("A1:H27")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Range("H1").Select
        Selection.End(xlDown).Select
        Range("H28").Select
        ActiveCell.FormulaR1C1 = "=SUM(R[-26]C:R[-1]C)"
        Columns("H:H").Select
        Selection.NumberFormat = "$ #,##0.00"
        Range("A1").Select
        Selection.CurrentRegion.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
        Range("H1").Select
        Selection.End(xlDown).Select
        Selection.Font.Bold = True
        Range("G28").Select
        Range(Selection, Selection.End(xlToLeft)).Select
        Selection.Clear
        Selection.End(xlUp).Select
        Selection.End(xlUp).Select
        Selection.End(xlToLeft).Select
        
        Cells.Select
        Cells.EntireColumn.AutoFit
        Selection.End(xlUp).Select
    Next sht
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 02/04/2015 7:56 am
 ghuto_lima
(@ghuto_lima)
Posts: 70
Estimable Member
Topic starter
 

Ola Fernando,

A Macro esta funcionando, só que ao executar ela, ela passa por todas as planilhas que já foram formatas.
Seria possível executar a Macro que estou visualizando?

Cada dia vou ter uma plan nova, e essa rotina será a mesma para todas, e quando executar essa Macro amanhã por exemplo, ela deverá executar somente na plan que estou trabalhando, as demais já foram executadas e formatadas.

Obrigado.

_________
Gustavo

 
Postado : 02/04/2015 8:17 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Tem sim, mas vc que havia pedido pra rodar em todas.
Agora vc quer que rode somente na atual, é isso?

Aqui está:

Sub arrumar()
Dim sht As Worksheet

    Set sht = ActiveSheet
    sht.Select
    Selection.CurrentRegion.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Font.Bold = True
    Selection.CurrentRegion.Select
    With sht
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("F2:F27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range("H2:H27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range("G2:G27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    End With
    With sht.Sort
        .SetRange Range("A1:H27")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("H1").Select
    Selection.End(xlDown).Select
    Range("H28").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-26]C:R[-1]C)"
    Columns("H:H").Select
    Selection.NumberFormat = "$ #,##0.00"
    Range("A1").Select
    Selection.CurrentRegion.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
    Range("H1").Select
    Selection.End(xlDown).Select
    Selection.Font.Bold = True
    Range("G28").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Clear
    Selection.End(xlUp).Select
    Selection.End(xlUp).Select
    Selection.End(xlToLeft).Select
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.End(xlUp).Select

End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 02/04/2015 8:25 am
 ghuto_lima
(@ghuto_lima)
Posts: 70
Estimable Member
Topic starter
 

PERFEITOOOOOOOOOOOOOO MEU AMIGOOO.

Muito obrigado.

Juro que estou tentando entender melhor essas funções de Macro, mas estou tendo dificuldade.
Agradeço sua ajuda e também do Forum muito útil.

Abraço.

_________
Gustavo

 
Postado : 02/04/2015 8:36 am
Forum Jump:
  Tópico Anterior
Próximo Tópico