Excel Erro no VBA de colar valores

[LucasExcel]

Bom dia, 

 

Na planilha em anexo e abaixo tem um código VBA com o objetivo de copiar os valores da aba "Scopo" e colar na aba"Dados". O código seleciona a célula A1 e copiar todos os valores que estão na planilha selecionando os valores através do  Ctrl + Shift + seta para baixo. O erro está que quando eu tenho só uma linha na aba "Scopo" ao executar o código onde ele seleciona os valores através do  Ctrl + Shift + seta para baixo o excel copia todas as células para baixo (independente se tem valor ou não)  e não cola apenas a linha com valores na aba "Dados".

Teste.xls

 

 

Sub Macro4()
'
' Macro4 Macro
'

'
    On Error Resume Next
    Sheets("Scopo").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Dados").Select
    Application.Goto Reference:="R1C13"
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.End(xlToLeft).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Dados").Select
    Range("B2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "m/d/yyyy h:mm"
    Range("Tabela1[[#Headers],[Placa]]").Select
    Sheets("Dados").Select
    Application.Goto Reference:="R1C1"
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Sheets("Instruções").Select
End Sub

[Midori]

@Luis Geraldo Como o problema esta no xlDown apenas quando a primeira linha tem dados, você pode verificar se A2 tem algum valor antes de executar o comando,

 

If Range("A2") <> "" Then Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select

 

[LucasExcel]

@Midori  Deveria ficar assim o código ?

A mudança está em negrito

 

    On Error Resume Next

    Sheets("Scopo").Select
     If Range("A2") <> "" Then Range(Selection, Selection.End(xlDown)).Select
    Range("A1").Select

    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Dados").Select
    Application.Goto Reference:="R1C13"
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.End(xlToLeft).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Dados").Select
    Range("B2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "m/d/yyyy h:mm"
    Range("Tabela1[[#Headers],[Placa]]").Select
    Sheets("Dados").Select
    Application.Goto Reference:="R1C1"
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Sheets("Instruções").Select
End Sub

[Muca Costa]

Sugestão:

 

Sub Macro4()
Dim A As String, B As String
    Plan4.Select
    A = Plan4.Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:I" & A).Select
    Selection.Copy
    Plan1.Select
    B = Plan1.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Range("A" & B).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Range("B2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "m/d/yyyy h:mm"
    Range("Tabela1[[#Headers],[Placa]]").Select
    Sheets("Dados").Select
    Application.Goto Reference:="R1C1"
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
MsgBox "Dados atualizados com sucesso", vbInformation, "© Muca Sistemas - 2020"
End Sub

[Midori]

@Luis Geraldo Não. Só tem que colocar o IF na frente do comando do xlDown assim,

 

 Sub Macro4()
'
' Macro4 Macro
'

'
    On Error Resume Nex
    Sheets("Scopo").Select
    Range("A1").Select
    If Range("A2") <> "" Then Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Dados").Select
    Application.Goto Reference:="R1C13"
    .
    .
    .

 

[Edson Luiz Branco]

Outra maneira de resolver seria:

Sub Macro4()
  Dim rgScopo As Range: Set rgScopo = Worksheets("Scopo").Range("A1").CurrentRegion
  Dim rgDados As Range
  With Worksheets("Dados").ListObjects("Tabela1").ListRows
    Set rgDados = .Add.Range.Resize(rgScopo.Rows.Count, rgScopo.Columns.Count)
    rgDados.Value = rgScopo.Value
    .Parent.ListColumns("Data de Entrada").DataBodyRange.NumberFormat = "m/d/yyyy h:mm"
    .Parent.ListColumns("Data de Saída").DataBodyRange.NumberFormat = "m/d/yyyy h:mm"
  End With
End Sub