Saltar al contenido

Apoyo para corregir macro que guarda datos


pedrosilv

Recommended Posts

publicado

Buen día a todos:

Por este medio quiero solicitar su apoyo para ayudarme a corregir una macro que me guarda unos datos de la hoja FORMULARIO a la hoja BASE.

El objetivo de guardar los datos a la hoja BASE se cumple parcialmente, pero tengo el siguiente problema: La idea es que antes de guardar los datos, la macro verifique si el campo "NUMERO DE SOLICITUD" que se encuentra en la celda B2 de la Hoja FORMULARIO, ya se ha guardado alguna vez en la hoja BASE. Si se comprueba que ya se ha guardado una vez, la macro debería sobreescribir la información en la fila donde ya estaba guardada en la hoja BASE; si en caso se comprueba que aún no se ha guardado, que copie la información en la primera fila vacía que se encuentre de la columna A de la hoja BASE. Y esto último es lo que no logro hacer funcionar, ya que la macro no sobreescribe cuando ya se encuentra el número de solicitud guardado una vez.

 

La macro que utilizo es la siguiente:

 

Sub ExportarBase()
   Dim Fila As Long
   Dim no As Range
   Application.ScreenUpdating = False
   Set no = Hoja2.Columns("A").Find(Hoja1.Range("a2"), , , xlWhole)
   If Not no Is Nothing Then
      Fila = no.Row
   Else
      Fila = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
   End If
    Hoja2.Range("A" & Fila) = Hoja1.Range("B1")
    Hoja2.Range("B" & Fila) = Hoja1.Range("B3")
    Hoja2.Range("C" & Fila) = Hoja1.Range("C6")
    Hoja2.Range("D" & Fila) = Hoja1.Range("C8")
    Hoja2.Range("E" & Fila) = Hoja1.Range("D11")
    
    
    Application.ScreenUpdating = True

End Sub

Acompaño un archivo de ejemplo que tengo trabajando, para ver si me pueden apoyar.

 

Desde ya, muchas gracias por su atención y el apoyo que puedan brindarme.

 

Saludos

 

 

 

 

Macro Guardar Datos.xlsm

publicado
Sub ExportarBase()
   Dim Fila As Long
   Dim no As Range
   Dim solicitud As String
   
   Application.ScreenUpdating = False
   solicitud = Hoja1.Cells(1, 2)
   ufh1 = Hoja2.Range("A" & Rows.Count).End(xlUp).Row
    
            
    With Hoja2.Range("A2:A" & ufh1)
    
        Set no = .Find(CDbl(solicitud), LookIn:=xlValues, lookat:=xlWhole)
        With Hoja2
            If Not no Is Nothing Then
                Fila = no.Row
                .Range("A" & Fila) = Hoja1.Range("B1")
                .Range("B" & Fila) = Hoja1.Range("B3")
                .Range("C" & Fila) = CDate(Hoja1.Range("C6"))
                .Range("D" & Fila) = CDate(Hoja1.Range("C8"))
                .Range("E" & Fila) = Hoja1.Range("D11")
            Else
                Fila = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & Fila) = Hoja1.Range("B1")
                .Range("B" & Fila) = Hoja1.Range("B3")
                .Range("C" & Fila) = CDate(Hoja1.Range("C6"))
                .Range("D" & Fila) = CDate(Hoja1.Range("C8"))
                .Range("E" & Fila) = Hoja1.Range("D11")
            End If
        End With
    End With
    
    Application.ScreenUpdating = True

End Sub

Prueba el adjunto y comenta.

Macro Guardar Datos Prueba 1.xlsm

publicado

Muchísimas gracias mi estimado.

La macro que me enviaste funciona a la perfección.

 

Mil gracias por tu aporte.

 

Saludos 

publicado

Me alegro mucho pero no olvides nunca agradecer a quien te ayuda o intenta ayudar y en este foro es mediante el corazoncillo que encontramos en la parte inferior derecha.

Agradecimiento.gif

publicado

Disculpa, una última consulta.

En la siguiente parte del código:

.Range("C" & Fila) = CDate(Hoja1.Range("C6"))
.Range("D" & Fila) = CDate(Hoja1.Range("C8"))

¿Por qué va "Cdate"?  

Saludos

publicado

Convierte un dato a fecha, creo que en tu caso no es necesario, ya que la información ya proviene de una celda con formato fecha.

De hecho tu macro ya funcionaba, solo había un error en la celda solicitud.

Sub ExportarBase()
   Dim Fila As Long
   Dim no As Range
   Application.ScreenUpdating = False
   Set no = Hoja2.Columns("A").Find(Hoja1.Range("B1"), , , xlWhole) '<---------------------
   If Not no Is Nothing Then
      Fila = no.Row
   Else
      Fila = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
   End If
    Hoja2.Range("A" & Fila) = Hoja1.Range("B1")
    Hoja2.Range("B" & Fila) = Hoja1.Range("B3")
    Hoja2.Range("C" & Fila) = Hoja1.Range("C6")
    Hoja2.Range("D" & Fila) = Hoja1.Range("C8")
    Hoja2.Range("E" & Fila) = Hoja1.Range("D11")
    Application.ScreenUpdating = True
End Sub

 

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.