Guilherme Benvenuto

@Basole a maco é a lista_match_pal, está em vermelho no código a linha que o depurador indica o erro. Obrigado pela atenção. Sub lista_match_pal() Dim answer As Integer Dim obj As Object Dim strMsg As String Set obj = CreateObject("WScript.Shell") Sheets("pal").Activate Application.ScreenUpdating = False Application.Calculation = xlManual Range("f2:m1000").ClearContents Range("o2:v1000").ClearContents Dim Ws1 As Worksheet Dim Ws2 As Worksheet Set Ws1 = Sheets("pal") Set Ws2 = Sheets("pal") UR1 = Ws1.Range("x" & Rows.Count).End(xlUp).Row For RR1 = 2 To UR1 If Ws1.Range("x" & RR1).Value = 0 Then UR2 = Ws2.Range("o" & Rows.Count).End(xlUp).Row + 1 Ws1.Range("z" & RR1 & ":ag" & RR1).Copy Ws2.Range("o" & UR2).PasteSpecial Paste:=xlPasteValues End If Next RR1 Application.CutCopyMode = False Application.Calculation = xlAutomatic Calculate LR = Cells(Rows.Count, "o").End(xlUp).Row Set rng = Range("o2:v" & LR) rng.Select Selection.Copy Cells(Cells(Rows.Count, "f").End(xlUp).Row + 1, "f").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False rng.Select Selection.ClearContents Application.CutCopyMode = False If Range("x1") = 2 Then Application.Calculation = xlManual Set Ws1 = Sheets("pal") Set Ws2 = Sheets("pal") UR1 = Ws1.Range("x" & Rows.Count).End(xlUp).Row For RR1 = 2 To UR1 If Ws1.Range("x" & RR1).Value = 2 Then UR2 = Ws2.Range("o" & Rows.Count).End(xlUp).Row + 1 Ws1.Range("z" & RR1 & ":ag" & RR1).Copy Ws2.Range("o" & UR2).PasteSpecial Paste:=xlPasteValues End If Next RR1 Application.CutCopyMode = False Application.Calculation = xlAutomatic Calculate LR = Cells(Rows.Count, "o").End(xlUp).Row Set rng = Range("o2:v" & LR) rng.Select Selection.Copy Cells(Cells(Rows.Count, "f").End(xlUp).Row + 1, "f").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False rng.Select Selection.ClearContents Application.CutCopyMode = False End If Sheets("dati").Activate Range("s2:ab2000").ClearContents Sheets("pal").Activate LR = Sheets("pal").Cells(Rows.Count, "g").End(xlUp).Row Set rng = Sheets("pal").Range("d2:m" & LR) rng.Select Selection.Copy Sheets("dati").Activate Cells(Cells(Rows.Count, "s").End(xlUp).Row + 1, "s").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Sheets("dati").Activate Range("b2:m2000").ClearContents Range("AG1").Select Selection.Copy Range("AG2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Application.Calculation = xlAutomatic Calculate Set rng = Nothing cont = 0 If Sheets("DATI").Range("ag2").Value > 0 Then Beep ' Application.Wait (Now + TimeValue("0:00:01")) strMsg = obj.popUp("Ciao le partite da elaborare sono.. " & Sheets("DATI").Range("AG2").Value, 2, "Attesa di 2sec se persiste..clicca su OK") Range("AG1").Select End If End Sub

Prezados, estou iniciando em VBA e estou com uma planilha italiana em que vem apresentando sistematicamente os erros citados acima. Gostaria de poder contar com a ajuda de vcs.Planilha Ambas Marcam.rar Abraços, Guilherme