Notifications
Clear all

Macro fera Erro

3 Posts
2 Usuários
0 Reactions
1,051 Visualizações
cleiton jm
(@cleiton-jm)
Posts: 115
Estimable Member
Topic starter
 

Bom dia pessoal, preciso de uma força a respeito de um erro que ocorre quando executo uma macro, e detalhe, só acontece quando execulto essa macro abaixo. A contece o seguinte eu exeuto a macro, salvo a planilha e hora que abro novamente planilha da os erros conforme em anexo, agora se eu tirar a macro e salvar a planilha ela volta a funcionar, só que sem a macro que mais preciso

Macro que tá gerando dor de cabeça:
Sub Filtro_302()
On Error Resume Next
Dim lastRow As Long
Dim x As Long
Dim lastResultRow, iSheet As Long

For iSheet = 3 To ActiveWorkbook.Worksheets.Count
lastResultRow = 1

lastRow = Plan2.Cells(Plan2.Cells.Rows.Count, "A").End(xlUp).Row
Worksheets(iSheet).RANGE("A1:G3000").ClearContents

For x = 1 To lastRow
If Plan2.Cells(x, "B").Value <> "" Then
If Plan2.Cells(x, "U").Value = 301 + iSheet - 2 & ".txt" Then
Worksheets(iSheet).Cells(lastResultRow, 1).Value = Plan2.Cells(x, 2).Value
Worksheets(iSheet).Cells(lastResultRow, 2).Value = Plan2.Cells(x, 3).Value
Worksheets(iSheet).Cells(lastResultRow, 3).Value = Plan2.Cells(x, 4).Value
Worksheets(iSheet).Cells(lastResultRow, 4).Value = Plan2.Cells(x, 9).Value
Worksheets(iSheet).Cells(lastResultRow, 5).Value = Plan2.Cells(x, 16).Value
Worksheets(iSheet).Cells(lastResultRow, 6).Value = Plan2.Cells(x, 21).Value
lastResultRow = lastResultRow + 1

End If
End If
Next x
lastResultRow = 1
lastRow = 1

Next iSheet
End Sub

Sub Filtro_Lado_302()
On Error Resume Next
Dim lastRow As Long
Dim x As Long
Dim lastResultRow As Long
Dim iSheet As Long

Plan1.Columns("A:G").ClearContents
For iSheet = 3 To ActiveWorkbook.Worksheets.Count
lastResultRow = 1
lastRow = Worksheets(iSheet).Cells(Worksheets(iSheet).Cells.Rows.Count, "A").End(xlUp).Row

Worksheets(iSheet).RANGE("G1:CT3000").ClearContents
'1-----------------------------------------------------------------------------
For x = 1 To lastRow
If Worksheets(iSheet).Cells(x, "a").Value = 1 Then

Let Worksheets(iSheet).Cells(lastResultRow, 7).Value = Worksheets(iSheet).Cells(x, 1).Value
Let Worksheets(iSheet).Cells(lastResultRow, 8).Value = Worksheets(iSheet).Cells(x, 2).Value
Let Worksheets(iSheet).Cells(lastResultRow, 9).Value = Worksheets(iSheet).Cells(x, 3).Value
Let Worksheets(iSheet).Cells(lastResultRow, 10).Value = Worksheets(iSheet).Cells(x, 4).Value
Let Worksheets(iSheet).Cells(lastResultRow, 11).Value = Worksheets(iSheet).Cells(x, 5).Value
Let Worksheets(iSheet).Cells(lastResultRow, 12).Value = Worksheets(iSheet).Cells(x, 6).Value

lastResultRow = lastResultRow + 1
End If
Next x
Next iSheet
End Sub

 
Postado : 25/03/2014 7:29 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

As rotinas não têm, aparentemente, qualquer problema. O erro reportado refere-se normalmente a um conteúdo corrompido; experimentou copiar as planilhas para um novo arquivo e depois reincluir as rotinas?

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

 
Postado : 25/03/2014 8:20 am
cleiton jm
(@cleiton-jm)
Posts: 115
Estimable Member
Topic starter
 

Descrobri o erro, era isso, na hora de classificar a planilha,
Substitui isso :
For iSheet = 3 To ActiveWorkbook.Worksheets.Count

Worksheets(iSheet).Columns("S:X").Sort Key1:=Worksheets(iSheet).RANGE("V1"), Order1:=xlDescending, Key2:=Worksheets(iSheet).RANGE("V1"), Order2:=xlDescending

Por isso:

Dim iSheet As Long

For iSheet = 3 To ActiveWorkbook.Worksheets.Count

Worksheets(iSheet).Sort.SortFields.Clear
Worksheets(iSheet).Sort.SortFields.Add Key:=Worksheets(iSheet).Columns("V:V"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With Worksheets(iSheet).Sort
.SetRange Columns("S:X")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Next

Obrigado pela ajuda reinaldo =)

 
Postado : 25/03/2014 10:52 am