Bom dia Jorge

Eu não testei, apenas acrescentei o que vc solicitou:

Private Sub AR()
Application.ScreenUpdating = False
LastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row

For i = 10 To LastRow

If Cells(i, 2) <> "" Then
Range(Cells(i, 2), Cells(i, 13)).Select
Selection.Copy

Workbooks.Open Filename:="C:PROGEPControle de AR.xlsm"
Dim p As Integer, q As Integer

p = Worksheets.Count

For q = 1 To p

If ActiveWorkbook.Worksheets(q).Name = "Plan1" Then
Worksheets("Plan1").Select
End If

Next q

erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Cells(erow, 1).Select
ActiveSheet. .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          .PasteSpecial Paste:=xlFormats

ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False
End If

Next i
Application.ScreenUpdating = True

End Sub

Se a resposta foi útil, clique na mãozinha que fica do lado da ferramenta Citar.

[]s

Patropi, bom dia!

Está mandando depurar na linha que você acrescentou pro worksheet.pastespecial...

Jorge

Agora que eu vi que ficou com 2 pontos no local quando eu colei a parte nova do código.

ActiveSheet. .PasteSpecial

[]s

Patropi

Eu já havia percebido estes dois pontos e corrigido, mas ainda assim continuou mandando depurar.

Coloquei meu arquivo em anexo.

O arquivo é o "Sistema de Controle de Correspondência" e o código está no botão "Salvar dados".

Desde já, obrigado!