Para mejorar macro que me habías enviado

Será mejor que me mandes el libro. Asi corrijo sobre él y veo como funciona.

Ya lo termine lo que pasa es que no me supe explicar lo que quería es que no me saliera tan largo que como se haría mas corto pero ya me funciona esta macro me envía los datos de HOJAREGISTRO a la hoja BDCOMPRAS cuando CeldaG47 y CeldaM43 no existe en BDCOMPRAS PERO TAMBIÉN QUERÍA COLICARLE UN MsgBox CON ACEPTAR Y CANCELAR A LA VES DONDE ME DIGA VUELVA A CHEQUEAR LOS DATOS QUE SERÁN MANDADO SIchequeo y están bueno clic en aceptar y termina de correr la macro si veo un error cancelo para parar el envío

Sub pasardatos()
Dim Rango As Range
Dim DireccionPrimera As String
Dim BusquedaTerminada, DatosEncontrados As Boolean
Dim CeldaG43, CeldaG45, CeldaG47, CeldaG49, CeldaG51, CeldaG53, CeldaG55, CeldaG57, CeldaG59, CeldaM43, CeldaM45, CeldaM47, CeldaM49, CeldaM51, CeldaM53, CeldaM55, CeldaM57, CeldaM59
CeldaG43 = Worksheets("HOJAREGISTRO").Cells(43, "G")
CeldaG45 = Worksheets("HOJAREGISTRO").Cells(45, "G")
CeldaG47 = Worksheets("HOJAREGISTRO").Cells(47, "G")
CeldaG49 = Worksheets("HOJAREGISTRO").Cells(49, "G")
CeldaG51 = Worksheets("HOJAREGISTRO").Cells(51, "G")
CeldaG53 = Worksheets("HOJAREGISTRO").Cells(53, "G")
CeldaG55 = Worksheets("HOJAREGISTRO").Cells(55, "G")
CeldaG57 = Worksheets("HOJAREGISTRO").Cells(57, "G")
CeldaG59 = Worksheets("HOJAREGISTRO").Cells(59, "G")
CeldaM43 = Worksheets("HOJAREGISTRO").Cells(43, "M")
CeldaM45 = Worksheets("HOJAREGISTRO").Cells(45, "M")
CeldaM47 = Worksheets("HOJAREGISTRO").Cells(47, "M")
CeldaM49 = Worksheets("HOJAREGISTRO").Cells(49, "M")
CeldaM51 = Worksheets("HOJAREGISTRO").Cells(51, "M")
CeldaM53 = Worksheets("HOJAREGISTRO").Cells(53, "M")
CeldaM55 = Worksheets("HOJAREGISTRO").Cells(55, "M")
CeldaM57 = Worksheets("HOJAREGISTRO").Cells(57, "M")
CeldaM59 = Worksheets("HOJAREGISTRO").Cells(59, "M")
If CeldaG47 <> "" And CeldaM43 <> "" Then
DatosEncontrados = False
Set Rango = Worksheets("BDCOMPRAS").Range("C:C").Find(CeldaG47)
If Not Rango Is Nothing Then
DireccionPrimera = Rango.Address
BusquedaTerminada = False
Do
If Worksheets("BDCOMPRAS").Cells(Rango.Row, "J") = CeldaM43 Then
MsgBox ("Los datos ya están registrados")
DatosEncontrados = True
BusquedaTerminada = True
End If
Set Rango = Worksheets("BDCOMPRAS").Range("C:C").FindNext(Rango)
If Rango.Address = DireccionPrimera Then BusquedaTerminada = True
Loop Until BusquedaTerminada
End If
If Not DatosEncontrados Then
Worksheets("BDCOMPRAS").Rows("2:2").Insert Shift:=xlDown
Worksheets("BDCOMPRAS").Cells(2, "A") = CeldaG43
Worksheets("BDCOMPRAS").Cells(2, "B") = CeldaG45
Worksheets("BDCOMPRAS").Cells(2, "C") = CeldaG47
Worksheets("BDCOMPRAS").Cells(2, "D") = CeldaG49
Worksheets("BDCOMPRAS").Cells(2, "E") = CeldaG51
Worksheets("BDCOMPRAS").Cells(2, "F") = CeldaG53
Worksheets("BDCOMPRAS").Cells(2, "G") = CeldaG55
Worksheets("BDCOMPRAS").Cells(2, "H") = CeldaG57
Worksheets("BDCOMPRAS").Cells(2, "I") = CeldaG59
Worksheets("BDCOMPRAS").Cells(2, "J") = CeldaM43
Worksheets("BDCOMPRAS").Cells(2, "K") = CeldaM45
Worksheets("BDCOMPRAS").Cells(2, "L") = CeldaM47
Worksheets("BDCOMPRAS").Cells(2, "M") = CeldaM49
Worksheets("BDCOMPRAS").Cells(2, "N") = CeldaM51
Worksheets("BDCOMPRAS").Cells(2, "O") = CeldaM53
Worksheets("BDCOMPRAS").Cells(2, "P") = CeldaM55
Worksheets("BDCOMPRAS").Cells(2, "Q") = CeldaM57
Worksheets("BDCOMPRAS").Cells(2, "R") = CeldaM59
End If
Else
MsgBox ("Falta algún dato")
End If
End Sub

Por ir las celdas separadas hemos perdido una oportunidad muy buena que habría sido copiar las celdas de G de HOJAREGISTRO y pegarlas en la hoja BDCOMPRAS transponiendo la columna por fila. Y luego hacer los mismo con las celdas de la columna M. Eso habría sido corto y rápido.

Asi tendremos que ir celda por celda, aunque se puede abreviar algo respecto de lo que tenemos.

No puedo probarlo si no me mandas el libro, me dice que falta algún dato. Mándamelo.

[email protected]

Como te decía, por ir las celdas separadas no se pueden hacer asignaciones directas rango a rango y hay que usar métodos de copiar y pegar transponiendo, una pena. Con eso no queda tan simplificada la macro y será así.

Sub pasardatos()
Dim Rango As Range
Dim DireccionPrimera As String
Dim BusquedaTerminada, DatosEncontrados As Boolean
Dim CeldaG47, CeldaM43
Dim Sh As Worksheet
CeldaG47 = Worksheets("HOJAREGISTRO").Cells(47, "G")
CeldaM43 = Worksheets("HOJAREGISTRO").Cells(43, "M")
If CeldaG47 <> "" And CeldaM43 <> "" Then
     DatosEncontrados = False
     Set Rango = Worksheets("BDCOMPRAS").Range("C:C").Find(CeldaG47)
     If Not Rango Is Nothing Then
         DireccionPrimera = Rango.Address
         BusquedaTerminada = False
         Do
             If Worksheets("BDCOMPRAS").Cells(Rango.Row, "J") = CeldaM43 Then
                 MsgBox ("Los datos ya están registrados")
                 DatosEncontrados = True
                 BusquedaTerminada = True
             End If
             Set Rango = Worksheets("BDCOMPRAS").Range("C:C").FindNext(Rango)
             If Rango.Address = DireccionPrimera Then BusquedaTerminada = True
         Loop Until BusquedaTerminada
     End If
     If Not DatosEncontrados Then
         Application.ScreenUpdating = False
         Set Sh = ActiveSheet
         Worksheets("hojaregistro").Range("g43,g45,g47,g49,g51,g53,g55,g57,g59").Copy
         Worksheets("bdcompras").Range("a2:i2").PasteSpecial Transpose:=True
         Worksheets("hojaregistro").Range("m43,m45,m47,m49,m51,m53,m55,m57,m59").Copy
         Worksheets("bdcompras").Range("j2:r2").PasteSpecial Transpose:=True
         Worksheets("bdcompras").Activate
         Range("A1").Select
         Application.CutCopyMode = False
        Sh.Activate
         Application.ScreenUpdating = True
         Set Sh = Nothing
     End If
Else
     MsgBox ("Falta algún dato")
End If
End Sub

Y eso es todo.