Bom dia!!

Tente assim...

Sub AutPROCV_AleVBA()
    Dim lr As Long
    With Sheets("NOVA.B.D")
        lr = .Cells(.Rows.Count, "D").End(xlUp).Row ' + 1
        With .Range("E2:J" & lr)
            .Formula = "=IF($D2<>"""",VLOOKUP($D2,BASE.DADOS.ANTIGA!$A$2:$G$16980,COLUMN()-3,0),"""")"
            .Value = .Value
        End With
    End With
End Sub

Boa tarde Alexandre,

Origado pela rápida resposta ao meu pedido.

Não sei se me fiz entender, mas precisava que o código procurasse na folha "BASE.DADOS.ANTIGA" o valor X, copiasse para a folha "NOVA.B.D" e que eliminasse a respetiva linha na folha "BASE.DADOS".

É possivel?

Cumprimentos

Boa tarde!!

tente Assim

Sub AutPROCV_AleVBA()
    Dim lr As Long
    With Sheets("NOVA.B.D")
        lr = .Cells(.Rows.Count, "D").End(xlUp).Row
        With .Range("E2:J" & lr)
            .Formula = "=IF($D2<>"""",VLOOKUP($D2,BASE.DADOS.ANTIGA!$A$2:$G$16980,COLUMN()-3,0),"""")"
            .Value = .Value
        End With
    End With
    Call EncontrarDeletar_AleVBA
End Sub

Sub EncontrarDeletar_AleVBA()
Dim lngLast As Long
Dim lngCounter As Long
Dim wsBase As Worksheet
Dim wsNova As Worksheet
Dim rngFound As Range

Set wsBase = Worksheets("BASE.DADOS.ANTIGA")
Set wsNova = Worksheets("NOVA.B.D")

With wsNova
  lngLast = .Cells(Rows.Count, "D").End(xlUp).Row
  For lngCounter = 2 To lngLast
    Set rngFound = wsBase.Columns(1).Find(what:=.Cells(lngCounter, "D").Value)
    If Not rngFound Is Nothing Then
      .Cells(lngCounter, "E").Resize(1, 6).Value = rngFound.Offset(0, 1).Resize(1, 6).Value
      rngFound.EntireRow.Delete
    End If
  Next lngCounter
End With

Set wsNova = Nothing
Set wsBase = Nothing
End Sub