Macro que envía datos si cumple dos condiciones encontradas necesito con tres condiciones

Respuesta de
a
Avatar
Usuario

haber si se incluye la celda G55 como otra condición que no se debe repetir en BDCOMPRAS TODO ESTA BIEN pero necesito que también verifique que si existe el dato G47 QUE YA ESTA, M43 QUE TAMBIÉN ESTA PERO NECESITO AÑADIR TAMBIÉN G55 QUE SI SE DA EL CASO DE QUE LOS 3 SE REPITEN AL MISMO TIEMPO NO ENVÍE CUALQUIER OTRA COSA QUE ENVÍE 

toda esta macro esta bien solo es añadir g55 como nuevo criterio

 

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, CeldaG61, CeldaG63, 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")
CeldaG61 = Worksheets("HOJAREGISTRO").Cells(61, "G")
CeldaG63 = Worksheets("HOJAREGISTRO").Cells(63, "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, "L") = 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("3:3").Insert Shift:=xlDown
      Worksheets("BDCOMPRAS").Cells(3, "A") = CeldaG43
      Worksheets("BDCOMPRAS").Cells(3, "B") = CeldaG45
      Worksheets("BDCOMPRAS").Cells(3, "C") = CeldaG47
      Worksheets("BDCOMPRAS").Cells(3, "D") = CeldaG49
      Worksheets("BDCOMPRAS").Cells(3, "E") = CeldaG51
      Worksheets("BDCOMPRAS").Cells(3, "F") = CeldaG53
      Worksheets("BDCOMPRAS").Cells(3, "G") = CeldaG55
      Worksheets("BDCOMPRAS").Cells(3, "H") = CeldaG57
      Worksheets("BDCOMPRAS").Cells(3, "I") = CeldaG59
      Worksheets("BDCOMPRAS").Cells(3, "J") = CeldaG61
      Worksheets("BDCOMPRAS").Cells(3, "K") = CeldaG63
      Worksheets("BDCOMPRAS").Cells(3, "L") = CeldaM43
      Worksheets("BDCOMPRAS").Cells(3, "M") = CeldaM45
      Worksheets("BDCOMPRAS").Cells(3, "N") = CeldaM47
      Worksheets("BDCOMPRAS").Cells(3, "O") = CeldaM49
      Worksheets("BDCOMPRAS").Cells(3, "P") = CeldaM51
      Worksheets("BDCOMPRAS").Cells(3, "Q") = CeldaM53
      Worksheets("BDCOMPRAS").Cells(3, "R") = CeldaM55
      Worksheets("BDCOMPRAS").Cells(3, "S") = CeldaM57
      Worksheets("BDCOMPRAS").Cells(3, "T") = CeldaM59
           
   End If
Else
   MsgBox ("Falta algún dato")
End If
End Sub

Avatar
Experto

¡Hola Alvaro1911!

 

Perdona, he estado unos días con otras tareas.  Ahora mismo no sé cuál es el punto en que está tu programa porque hice algunas correcciones sin que me mandaras el fichero.  Será mejor que me lo mandes ya como lo tienes actualmente y así trabajo sobre él, es mucho mejor.

 

Un saludo.

Avatar
Usuario

ok mi amigo hace 4 días te envíen el fichero se llama modulo de compras todo ha sido excelente de verdad he podido adaptar bastante lo que quiero en el fichero te envío las acotaciones de los arreglos que quisiera si puedes ayudarme