Excel - Codigo para insertar datos

 
Vista:

Codigo para insertar datos

Publicado por Hector (1 intervención) el 23/09/2017 15:48:41
Buen dia, tengo este problema no se nada de programación, tengo un libro de excel con varias hojas desde las cuales quiero ingresar datos a una base de datos; tengo este código para un botón pero solo inserta datos de una hoja especifica, quiero utilizar este código para todas las hojas que dependiendo donde este ubicado inserte los datos de esa hoja. gracias por su amable ayuda.



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub Captura_Datos()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
'
strTitulo = "Insertar Datos"
'
Continuar = MsgBox("Insertar los datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets("Costos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets("Costos")
    .Cells(NewRow, 1).Value = ThisWorkbook.Sheets(8).Range("L25")
    .Cells(NewRow, 2).Value = ThisWorkbook.Sheets(8).Range("C8")
    .Cells(NewRow, 3).Value = ThisWorkbook.Sheets(8).Range("H25")
    .Cells(NewRow, 4).Value = ThisWorkbook.Sheets(8).Range("F25")
    .Cells(NewRow, 8).Value = ThisWorkbook.Sheets(8).Range("D26")
End With
'
MsgBox "Operacion exitosa.", vbInformation, strTitulo
Limpiar = MsgBox("Deseas limpiar los campos de la captura?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
    With ActiveWorkbook.Sheets(1)
        .Range("L25").ClearContents
        .Range("C8").ClearContents
        .Range("H25").ClearContents
        .Range("F25").ClearContents
        .Range("D26").ClearContents
        'ClearContents no funciona en celda combinada...
        .Range("C27").Value = ""
    End With
Else
End If
'
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Codigo para insertar datos

Publicado por Antoni Masana (2478 intervenciones) el 25/09/2017 08:19:02
No le veo el sentido a esta macro y si su funcionamiento es el correcto y el mejor. Lo que deduzco que hace:
- Pregunta Insertar los datos?
- Si es afirmativo copia los datos de la hoja 8 ¿Cúal es la hoja 8? a la hoja Costos pero quieres que sea a la hoja activa
- Pregunta Deseas limpiar los campos de la captura?
- Si es afirmativo limpia las celdas de la hoja 1 ¿Cúal es la hoja 1?

Así a groso modo esta es una solución, no la mejor pero una.

Hay 2 líneas que se deben modificar para que la macro actúe sobre cualquier hoja activa. En las líneas 16 y 18 del código adjunto cambió el el nombre de la hoja "Costos" por el nombre de la hoja activa que se obtiene en la línea 11.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub Captura_Datos()
    'Declaración de variables
    '
    Dim strTitulo As String
    Dim Continuar As String
    Dim TransRowRng As Range
    Dim NewRow As Integer
    Dim Limpiar As String, C_Nombre As String
    '
    strTitulo = "Insertar Datos"
    c_Nombre = ActiveSheet.Name
    '
    Continuar = MsgBox("Insertar los datos?", vbYesNo + vbExclamation, strTitulo)
    If Continuar = vbNo Then Exit Sub
    '
    Set TransRowRng = ThisWorkbook.Worksheets(c_Nombre).Cells(1, 1).CurrentRegion
    NewRow = TransRowRng.Rows.Count + 1
    With ThisWorkbook.Worksheets(c_Nombre)
        .Cells(NewRow, 1).Value = ThisWorkbook.Sheets(8).Range("L25")
        .Cells(NewRow, 2).Value = ThisWorkbook.Sheets(8).Range("C8")
        .Cells(NewRow, 3).Value = ThisWorkbook.Sheets(8).Range("H25")
        .Cells(NewRow, 4).Value = ThisWorkbook.Sheets(8).Range("F25")
        .Cells(NewRow, 8).Value = ThisWorkbook.Sheets(8).Range("D26")
    End With
    '
    MsgBox "Operacion exitosa.", vbInformation, strTitulo
    Limpiar = MsgBox("Deseas limpiar los campos de la captura?", vbYesNo, strTitulo)
    If Limpiar = vbYes Then
        With ActiveWorkbook.Sheets(1)
            .Range("L25").ClearContents
            .Range("C8").ClearContents
            .Range("H25").ClearContents
            .Range("F25").ClearContents
            .Range("D26").ClearContents
            'ClearContents no funciona en celda combinada...
            .Range("C27").Value = ""
        End With
    Else
    End If
'
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil
Val: 3
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Codigo para insertar datos

Publicado por Arnoldo (2 intervenciones) el 07/10/2017 16:27:30
Antoni ocupo de su ayuda ocupo esta misma macro pero que venga de un formulario y cómo hacer el formulario en este caso.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

Codigo para insertar datos

Publicado por Rafa Lopez (1 intervención) el 27/01/2019 12:03:57
Hola buenos días amigos, solicito ayuda ya que no me defiendo nada en VB. les cuento, tengo varias hojas donde en la hoja Datos introduzco los datos y tras darle al boton que contiene la macro de validar datos, estos sean introducidos en la hoja que previamente he designado en la celda d3 de la hoja de datos.

En el ejemplo que indican en esta pagina lo que hace es introducir los datos que se han asignado en la hoja1 a la hoja8, pero yo como he comentado, necesito que esos datos sean introducidos en la hoja según el nombre que he introducido en la celda d3, es decir, tengo además de la hoja Datos, tengo las hojas Prueba1, Prueba2, Prueba3, etc. y si en la celda d3 tengo Prueba2, estos datos se tienen que guardar en la hoja Prueba2.

Espero haya sido claro en la explicación, así como también espero vuestra ayuda, ya que no se como hacerlo. Muchísimas gracias. Un saludo.

Esto es lo que tengo y no funciona.


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Sub Captura_Datos()
'Declaración de variables
'
Dim strTitulo As String
Dim Continuar As String
Dim TransRowRng As Range
Dim NewRow As Integer
Dim Limpiar As String
Dim tuvariable As String
tuvariable = Worksheets("Datos").Range("d3").Value
 
'
strTitulo = "Datos Semana"
'
Continuar = MsgBox("Dar de alta los datos?", vbYesNo + vbExclamation, strTitulo)
If Continuar = vbNo Then Exit Sub
'
Set TransRowRng = ThisWorkbook.Worksheets(tuvariable).Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With ThisWorkbook.Worksheets(tuvariable)
    .Cells(NewRow, 1).Value = ThisWorkbook.Sheets("Hoja1").Range("C7")
    .Cells(NewRow, 2).Value = ThisWorkbook.Sheets("Hoja1").Range("d7")
    .Cells(NewRow, 3).Value = ThisWorkbook.Sheets("Hoja1").Range("C8")
    .Cells(NewRow, 4).Value = ThisWorkbook.Sheets("Hoja1").Range("d8")
    .Cells(NewRow, 5).Value = ThisWorkbook.Sheets("Hoja1").Range("C9")
    .Cells(NewRow, 6).Value = ThisWorkbook.Sheets("Hoja1").Range("d9")
    .Cells(NewRow, 7).Value = ThisWorkbook.Sheets("Hoja1").Range("C10")
    .Cells(NewRow, 8).Value = ThisWorkbook.Sheets("Hoja1").Range("d10")
    .Cells(NewRow, 9).Value = ThisWorkbook.Sheets("Hoja1").Range("c11")
    .Cells(NewRow, 10).Value = ThisWorkbook.Sheets("Hoja1").Range("d11")
    .Cells(NewRow, 11).Value = ThisWorkbook.Sheets("Hoja1").Range("c12")
    .Cells(NewRow, 12).Value = ThisWorkbook.Sheets("Hoja1").Range("d12")
    .Cells(NewRow, 13).Value = ThisWorkbook.Sheets("Hoja1").Range("c13")
    .Cells(NewRow, 14).Value = ThisWorkbook.Sheets("Hoja1").Range("d13")
    .Cells(NewRow, 15).Value = ThisWorkbook.Sheets("Hoja1").Range("c14")
    .Cells(NewRow, 16).Value = ThisWorkbook.Sheets("Hoja1").Range("d14")
End With
'
MsgBox "Alta exitosa.", vbInformation, strTitulo
Limpiar = MsgBox("Deseas limpiar los campos de la captura?", vbYesNo, strTitulo)
If Limpiar = vbYes Then
    With ActiveWorkbook.Sheets("Hoja1")
        .Range("C7").ClearContents
        .Range("C8").ClearContents
        .Range("C9").ClearContents
        .Range("C10").ClearContents
        .Range("C11").ClearContents
        .Range("C12").ClearContents
        .Range("C13").ClearContents
        .Range("C14").ClearContents
        .Range("d7").ClearContents
        .Range("d8").ClearContents
        .Range("d9").ClearContents
        .Range("d10").ClearContents
        .Range("d11").ClearContents
        .Range("d12").ClearContents
        .Range("d13").ClearContents
        .Range("d14").ClearContents
        .Range("F9").ClearContents
        .Range("F12").ClearContents
        'ClearContents no funciona en celda combinada...
        .Range("F15").Value = ""
    End With
Else
End If
'
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar