Saltar al contenido

Apoyo para corregir macro que guarda datos


pedrosilv

Recommended Posts

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

Enlace a comentario
Compartir con otras webs

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

Enlace a comentario
Compartir con otras webs

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

 

Enlace a comentario
Compartir con otras webs

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.