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

Executar Macro para varias planinhas

 
2024 - VBA & Macros
8 Posts
2 Usuários
0 Reactions
1,748 Visualizações
RSS
 ghuto_lima
(@ghuto_lima)
Posts: 70
Estimable Member
Topic starter
 

Ola Pessoal,
Bom dia.

Tenha um arquivo de excel com varias planilhas e nessas planilhas sera executada a mesma macro.
Porem como cada plan tem novo diferente a macro da erro, só consigo executar a macro se o nome da plan estiver na macro.
Como faço para executar a macro independente do nome da plan?

Vejam que "RI" é nome da plan, mas esse nome vai mudando.

Obrigado.

Sub arrumar()
'
' arrumar Macro
'

'
    ActiveWorkbook.Worksheets("RI").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RI").Sort.SortFields.Add Key:=Range("P2:P1000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("RI").Sort.SortFields.Add Key:=Range("M2:M1000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("RI").Sort.SortFields.Add Key:=Range("N2:N1000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RI").Sort
        .SetRange Range("A1:AE1000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    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
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
End Sub
 
Postado : 11/01/2017 8:59 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia Ghuto,

Você pode fazer um loop... Ou tudo ao mesmo tempo (grupo)...
Será em todas as Sheets ou algumas?
Da quantidade de Sheets, tem mais que serão executadas ou a maioria não será executada?

Qualquer coisa da o grito.
Abraço

 
Postado : 11/01/2017 9:04 am
 ghuto_lima
(@ghuto_lima)
Posts: 70
Estimable Member
Topic starter
 

Ola Bernardo.

Essa macro sera executada em todas as plans.
Não tem um número exato, pode varias muito, as vezes pode ter 2, 5, 8.
Então cada nova plan criada, quero executar a mesma macro.

Sou bem leigo nas criação de Macros.

Valeu pela ajuda.

 
Postado : 11/01/2017 9:23 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

tenta assim:

Option Explicit

Sub arrumar()
Dim ws      As Worksheet
Dim UltL    As Long
Dim i       As Long
Dim j       As Long

    Application.ScreenUpdating = False
    
    For i = 1 To ThisWorkbook.Worksheets.Count
        Set ws = ThisWorkbook.Worksheets(i)
        UltL = ws.Cells(Rows.Count, 16).End(xlUp).Row
        
        ws.Activate
        ws.Sort.SortFields.Clear
        ws.Sort.SortFields.Add Key:=ws.Range("P2:P" & UltL), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        ws.Sort.SortFields.Add Key:=ws.Range("M2:M" & UltL), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        ws.Sort.SortFields.Add Key:=ws.Range("N2:N" & UltL), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            
        With ws.Sort
            .SetRange Range("A1:AE" & UltL)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        Selection.CurrentRegion.Select
        With ws.Selection
            For j = 5 To 6
                .Borders(j).LineStyle = xlNone
            Next j
            For j = 7 To 12
                .Borders(j).LineStyle = xlContinuous
            Next j
        End With
        
        Cells.Select
        Cells.EntireColumn.AutoFit
        ws.Range("A1").Select
        
    Next i
    
    Set ws = Nothing
    Application.ScreenUpdating = True
    MsgBox "Processo finalizado com sucesso!" & vbNewLine & "Planilhas executadas: " & i
        
End Sub

Qualquer coisa da o grito.
Abraço

 
Postado : 11/01/2017 9:48 am
 ghuto_lima
(@ghuto_lima)
Posts: 70
Estimable Member
Topic starter
 

Bernardo,

Deu erro aqui

Selection.CurrentRegion.Select
With ws.Selection
For j = 5 To 6
.Borders(j).LineStyle = xlNone

 
Postado : 11/01/2017 11:43 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Estranho....
Mas deixa assim:

With Selection

Qualquer coisa da o grito.
Abraço

 
Postado : 11/01/2017 11:55 am
 ghuto_lima
(@ghuto_lima)
Posts: 70
Estimable Member
Topic starter
 

Nossa...hahaha

Agora esta executando a macro em todas as plan ao mesmo tempo.
Teria que ser na plan que estou visualizando.
Se eu troca de plan, executo a macro, troco de plan, executo novamente.

É uma execução de plan por plan mas a que estou visualizando.

Mais uma vez obrigado.

 
Postado : 11/01/2017 4:14 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Aaah, então nem precisa de loop... Só mandar executar na Sheet ativa.

Option Explicit

Sub arrumar()
Dim ws      As Worksheet
Dim UltL    As Long
'Dim i       As Long
Dim j       As Long

    Application.ScreenUpdating = False
    
'    For i = 1 To ThisWorkbook.Worksheets.Count
        Set ws = ThisWorkbook.activesheet
        UltL = ws.Cells(Rows.Count, 16).End(xlUp).Row
        
        ws.Activate
        ws.Sort.SortFields.Clear
        ws.Sort.SortFields.Add Key:=ws.Range("P2:P" & UltL), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        ws.Sort.SortFields.Add Key:=ws.Range("M2:M" & UltL), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        ws.Sort.SortFields.Add Key:=ws.Range("N2:N" & UltL), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            
        With ws.Sort
            .SetRange Range("A1:AE" & UltL)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        
        Selection.CurrentRegion.Select
        With Selection
            For j = 5 To 6
                .Borders(j).LineStyle = xlNone
            Next j
            For j = 7 To 12
                .Borders(j).LineStyle = xlContinuous
            Next j
        End With
        
        Cells.Select
        Cells.EntireColumn.AutoFit
        ws.Range("A1").Select
        
'    Next i
    
    Set ws = Nothing
    Application.ScreenUpdating = True
    MsgBox "Processo finalizado com sucesso!" ' & vbNewLine & "Planilhas executadas: " & i
        
End Sub

Acho que vai funcionar...
Mas pooooode ser que tenha que ajustar algo.
Estou pelo celular.

Qualquer coisa da o grito.
Abraço

 
Postado : 11/01/2017 4:44 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico