Guardar datos en una hoja específica para registrar todos los datos.

[francis75]

Hola, necesito guardar unos datos al pulsar el botón "Guardar" a una hoja llamada "Registro".

Subo un archivo donde viene explicado y detallado como necesito que se haga el proceso.

Espero me puedan ayudar.

Registro.zip

[francis75]

Hola despues de mirar muchos códigos por el foro he conseguido uno que me va a valer para partir al resultado que pretendo.

Espero que poco a poco puedan ayudarme a confeccionar la macro.

La macro la funcionalidad que tiene es que al pulsar en Guardar se copian los datos a la hoja Registro, lo que pretendo es que si vuelvo a pulsar en Guardar se actualicen dichos datos si éstos ya existen, pero ahora si pulso se me copia la fila 21 en la fila 1 de la hoja Registro, pulsen y vean, y no entiendo el porqué.

Aquí os pongo la macro tal cual la tengo ahora:

Sub Guardar()

Dim hoja As Object

Dim archivo As String

Dim hojaDestino As Object

Dim existe

Dim xFil As Long



On Error Resume Next

Application.ScreenUpdating = False

Set hoja = ActiveSheet

archivo = Range("C3")

Set hojaDestino = Sheets("Registro")

Set existe = hojaDestino.Columns("A:A").Find(archivo)



    With hojaDestino

        If existe = "" Then xFil = .Range("A" & Rows.Count).End(xlUp)(2).Row

        If existe <> "" Then existe = existe

        With .Range("A" & xFil)

            .Value = hoja.Range("C3")

            .NumberFormat = "000000"

        End With

        .Range("B" & xFil) = hoja.Range("C5")

        .Range("C" & xFil) = hoja.Range("F5")

        .Range("D" & xFil) = hoja.Range("C7")

        .Range("E" & xFil) = hoja.Range("C9")

        .Range("F" & xFil) = hoja.Range("C11")

        With .Range("A" & xFil + 1)

            .Value = hoja.Range("C3")

            .NumberFormat = "000000"

        End With

        With .Range("C" & xFil + 1)

            .Value = hoja.Range("A21")

            .NumberFormat = "dd/mm/yy"

        End With

        .Range("D" & xFil + 1) = hoja.Range("B21")

        .Range("E" & xFil + 1) = hoja.Range("C21")

        .Range("F" & xFil + 1) = hoja.Range("D21")

        If existe <> "" Then existe = existe + 1

    End With

Set existe = Nothing

Set hojaDestino = Nothing

Set libro = Nothing

End Sub[/CODE]

Si por favor me pueden ayudar se lo agradecería.

Saludos.

Registro2.zip

[francis75]

Hola de nuevo,

Con respecto con la consulta anterior he conseguido solventar el problema, aquí está la macro:

Option ExplicitSub Guardar()

    Dim Id As String

    Dim hoja As Object

    Dim hojaDestino As Object

    Dim xFil As Long

    Dim existe

On Error Resume Next

Application.ScreenUpdating = False

Id = Range("C3")

Set hoja = ActiveSheet

Set hojaDestino = Sheets("Registro")

existe = Application.WorksheetFunction.Match(Id, hojaDestino.Columns("A:A"), 0)

        With hojaDestino

            If existe = "" Then xFil = .Range("A" & Rows.Count).End(xlUp)(2).Row

            If existe <> "" Then xFil = existe

            .Range("A" & xFil) = hoja.Range("C3")

            .Range("B" & xFil) = hoja.Range("C5")

            .Range("C" & xFil) = hoja.Range("F5")

            .Range("D" & xFil) = hoja.Range("C7")

            .Range("E" & xFil) = hoja.Range("C9")

            .Range("F" & xFil) = hoja.Range("C11")


            .Range("A" & xFil + 1) = hoja.Range("C3")

            With .Range("C" & xFil + 1)

                .Value = hoja.Range("A21")

                .NumberFormat = "dd/mm/yy"

            End With

            '.Range("C" & xFil + 1) = hoja.Range("A21")

            .Range("D" & xFil + 1) = hoja.Range("B21")

            .Range("E" & xFil + 1) = hoja.Range("C21")

            .Range("F" & xFil + 1) = hoja.Range("D21")

            If existe <> "" Then existe = existe + 1

        End With

Set hojaDestino = Nothing

Application.ScreenUpdating = True

End Sub[/CODE]

aunque tengo un problema con la celda C3 y es que si coloco numeros la macro no me funciona como debiera, en cambio si pongo palabras como lo que está ahora "Op01" si funciona, ¿alguien sabe porque sucede?, alguna forma de solventarlo?

La otra cuestión, es que quiero que aparezca todo el recuadro.

[b]MUY IMPORTANTE:[/b] teniendo en cuenta que este cuadro puede tener 2 filas de datos como puede tener 50 filas de datos, [u]es variable[/u].

Lo he intentado con la función [b]For[/b] pero no he dado con la solución.

Subo el archivo donde detallo lo expuesto anteriormente,

Espero me podais ayudar, Saludos.

Registro3.zip

[supervoro]

Hola Francis75... revisa el codigo que te mando a ver si te sirve...

Option Explicit

Sub Guardar()

Dim J As Integer

Dim DATOS As Variant

Dim Id As String

Dim hoja As Object

Dim hojaDestino As Object

Dim xFil As Long

Dim existe

On Error Resume Next

Application.ScreenUpdating = False

Id = Range("C3")

Set hoja = ActiveSheet

Set hojaDestino = Sheets("Registro")

existe = Application.WorksheetFunction.Match(Id, hojaDestino.Columns("A:A"), 0)

With hojaDestino

If existe = "" Then xFil = .Range("A" & Rows.Count).End(xlUp)(2).Row

If existe <> "" Then xFil = existe

.Range("A" & xFil) = hoja.Range("C3")

.Range("B" & xFil) = hoja.Range("C5")

.Range("C" & xFil) = hoja.Range("F5")

.Range("D" & xFil) = hoja.Range("C7")

.Range("E" & xFil) = hoja.Range("C9")

.Range("F" & xFil) = hoja.Range("C11")

With .Range("C" & xFil + 1)

.NumberFormat = "dd/mm/yy"

End With

DATOS = Application.WorksheetFunction.Count(Range("a21:a65536"))

For J = 1 To DATOS

With hojaDestino

.Range("A" & xFil + J) = hoja.Cells(3, 3)

.Range("C" & xFil + J) = hoja.Cells(20 + J, 1)

With .Range("C" & xFil + J)

.NumberFormat = "dd/mm/yy"

End With

.Range("D" & xFil + J) = hoja.Cells(20 + J, 2)

.Range("E" & xFil + J) = hoja.Cells(20 + J, 3)

.Range("F" & xFil + J) = hoja.Cells(20 + J, 4)

End With

Next J

'.Range("A" & xFil + 1) = hoja.Range("C3")

'.Range("C" & xFil + 1) = hoja.Range("A21")

' .Range("D" & xFil + 1) = hoja.Range("B21")

' .Range("E" & xFil + 1) = hoja.Range("C21")

' .Range("F" & xFil + 1) = hoja.Range("D21")

If existe <> "" Then existe = existe + 1

End With

Set hojaDestino = Nothing

Application.ScreenUpdating = True

End Sub