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