Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Macro para adicionar registros de una hoja a una base de datos nueva

Oscar Arroyave

Recommended Posts

Dr Hyde Novato

Dr Hyde

publicado
publicado

copiar el boton no significa que la macro se copia, cada que copies el boton debes entrar al boton y darle el nombre la macro que se va a ejecutar en este caso copia2, das click con el boton derecho sobre el boton y seleccionas ver codigo, si esta vacia te va a aparecer asi:

el numero se va a ir incrementado cada que hagas una copia

Private Sub CommandButton2_Click()
End Sub

tu agregas lo siguiente

Private Sub CommandButton2_Click()
copia2
End Sub

y la macro tiene que estar en el libro que estes usando sino te va a marcar error

Oscar Arroyave Novato

Oscar Arroyave

publicado
  • Autor
publicado

Dr. Hyde, buenas tardes

Realice otra prueba, fue la siguiente:

1. Copie los datos que tenemos en el archivo  ("Prueba Copia de Registros sin Filas en Blanco (2)")  al archivo original donde tengo los días.

2. Ejecute el Botón Resumir y funciona.

3. Según esto el formato del copiar las filas tiene algo que ver?

Gracias

 

Oscar Arroyave Novato

Oscar Arroyave

publicado
  • Autor
publicado

Dr. Hyde, disculpe por tanta molestia, pero de tanto hacer pruebas, borrar y volver a colocar todo, volvi a ejecutar y si funciono, me copio los registros, que FELICIDAD, usted si sabe de esto, ojala pudiera aprender de esa manera

Pero como siempre una pregunta, al copiar los datos en la Base de Datos, porque no respeta el formato de los campos de la  de la Base de Datos?

1. Le envío copia como me quedan los datos en la Base de datos, son los 3 últimos.

2. Las dos Macros como quedaron asi, o sera que se pueden realizar en un solo Botón?

PRIMERA MACRO - BOTON DE COPIAR REGISTROS DONDE NO HAYA FILAS EN BLANCO.

Option Base 1
Sub copiar()
' Desabilita los campos de Nombre Px y Tratamiento
    Application.EnableEvents = False
    Application.ScreenUpdating = False
' Desprotege la hoja
Cells.Select
    Range("C1").Activate
    ActiveSheet.Unprotect
' Empieza el traslado de los registros sin filas en blanco
Set datos = Range("a320").CurrentRegion
Set datos = datos.Rows(1).Resize(149, datos.Columns.Count)

Set origen = datos.Offset(1, 0).Resize(datos.Rows.Count - 1, datos.Columns.Count)
Range("a500").Resize(origen.Rows.Count, origen.Columns.Count).ClearContents
Set destino = Range("a500").Resize(origen.Rows.Count, origen.Columns.Count)
ReDim matriz(datos.Rows.Count, datos.Columns.Count)

a = 1
For Each Fila In origen.Rows
    fil = Fila.Row - origen.Row + 1
    f = Fila
    If f(1, 4) = Empty Then GoTo siguiente
    
    For i = 1 To origen.Columns.Count
        matriz(a, i) = f(1, i)
    Next i
    a = a + 1
siguiente:
Next Fila

Range(destino.Address) = matriz
origen.Rows(0).Copy destino.Rows(0)
'destino.Select
' Protege la hoja
 Cells.Select
    Range("C1").Activate
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Habilita campos de Nombre Px y Tratamientos
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

SEGUNDA MAGRO - BOTON COPIAR REGISTROS DE UNA HOJA A LA BASE DE DATOS EXTERNA

Sub copia2()
' Desabilita los campos de Nombre Px y Tratamiento
    Application.EnableEvents = False
    Application.ScreenUpdating = False
' Desprotege la hoja
Cells.Select
    Range("C1").Activate
    ActiveSheet.Unprotect
Set hd = Workbooks("0. Base_Datos_Acumulada.xlsm")
Set destino = hd.ActiveSheet.Range("a1").CurrentRegion

Set ho = ActiveWorkbook
Set origen = ho.ActiveSheet.Range("a500").CurrentRegion

c = origen.Rows(1).Interior.ColorIndex

If c = 15 Then
    Set origen = origen.Rows(2).Resize(origen.Rows.Count - 1, origen.Columns.Count)
End If

origen.Copy destino.Rows(destino.Rows.Count + 1)
' Protege la hoja
 Cells.Select
    Range("C1").Activate
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Habilita campos de Nombre Px y Tratamientos
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

No tengo palabras para agradecerle todo lo que me ha aguantado, he aprendido, pero cada vez veo que se menos.

 

Muchas gracias y mil gracias.

 

0. Base_Datos_Acumulada - copia.xlsm

Oscar Arroyave Novato

Oscar Arroyave

publicado
  • Autor
publicado

Dr. Hyde, buenos días

Lastima le escribí anoche informando que ya me funciona, pero queria perfeccionarlo, no se porque no paso el correo. 

1. Relaciono Macro Copiar Registros sin filas en Blanco 

  • Nombre del Boton o Macro: "Copiar"

Sub copiar()
' Desabilita los campos de Nombre Px y Tratamiento
    Application.EnableEvents = False
    Application.ScreenUpdating = False
' Desprotege la hoja
Cells.Select
    Range("C1").Activate
    ActiveSheet.Unprotect
' Empieza el traslado de los registros sin filas en blanco
Set datos = Range("a320").CurrentRegion
Set datos = datos.Rows(1).Resize(149, datos.Columns.Count)

Set origen = datos.Offset(1, 0).Resize(datos.Rows.Count - 1, datos.Columns.Count)
Range("a500").Resize(origen.Rows.Count, origen.Columns.Count).ClearContents
Set destino = Range("a500").Resize(origen.Rows.Count, origen.Columns.Count)
ReDim matriz(datos.Rows.Count, datos.Columns.Count)

a = 1
For Each Fila In origen.Rows
    fil = Fila.Row - origen.Row + 1
    f = Fila
    If f(1, 4) = Empty Then GoTo siguiente
    
    For i = 1 To origen.Columns.Count
        matriz(a, i) = f(1, i)
    Next i
    a = a + 1
siguiente:
Next Fila

Range(destino.Address) = matriz
origen.Rows(0).Copy destino.Rows(0)
'destino.Select
' Protege la hoja
 Cells.Select
    Range("C1").Activate
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Habilita campos de Nombre Px y Tratamientos
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

2. Relaciono Macro que Copia Registros de una hoja a un archivo Externo

  • Nombre del Boton o Macro: "Copiar2"

Sub copia2()
' Desabilita los campos de Nombre Px y Tratamiento
    Application.EnableEvents = False
    Application.ScreenUpdating = False
' Desprotege la hoja
Cells.Select
    Range("C1").Activate
    ActiveSheet.Unprotect
Set hd = Workbooks("0. Base_Datos_Acumulada.xlsm")
Set destino = hd.ActiveSheet.Range("a1").CurrentRegion

Set ho = ActiveWorkbook
Set origen = ho.ActiveSheet.Range("a500").CurrentRegion

c = origen.Rows(1).Interior.ColorIndex

If c = 15 Then
    Set origen = origen.Rows(2).Resize(origen.Rows.Count - 1, origen.Columns.Count)
End If

origen.Copy destino.Rows(destino.Rows.Count + 1)
' Protege la hoja
 Cells.Select
    Range("C1").Activate
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Habilita campos de Nombre Px y Tratamientos
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

3. Porque cuando copia los registros al archivo de la Base de datos o cuando ejecuta la primera macro no que copia los registros sin filas en blanco, no los copia con el formato?

  • Adjunto Archivo de muestra, son los últimos tres registros, que no quedan con el formato de la Base de Datos.

 

Nuevamente no tengo sino palabras de agradecimiento y de saber como me puedo capacitar, ojala aprendiendo por lo menos del 10% que usted sabe, para entender el manejo de todas estas rutinas, macros, instrucciones, etc...

0. Base_Datos_Acumulada - copia.xlsm

Oscar Arroyave Novato

Oscar Arroyave

publicado
  • Autor
publicado
Hace 20 horas, Oscar Arroyave dijo:

Dr. Hyde, disculpe por tanta molestia, pero de tanto hacer pruebas, borrar y volver a colocar todo, volvi a ejecutar y si funciono, me copio los registros, que FELICIDAD, usted si sabe de esto, ojala pudiera aprender de esa manera

Pero como siempre una pregunta, al copiar los datos en la Base de Datos, porque no respeta el formato de los campos de la  de la Base de Datos?

1. Le envío copia como me quedan los datos en la Base de datos, son los 3 últimos.

2. Las dos Macros como quedaron asi, o sera que se pueden realizar en un solo Botón?

PRIMERA MACRO - BOTON DE COPIAR REGISTROS DONDE NO HAYA FILAS EN BLANCO.

Option Base 1
Sub copiar()
' Desabilita los campos de Nombre Px y Tratamiento
    Application.EnableEvents = False
    Application.ScreenUpdating = False
' Desprotege la hoja
Cells.Select
    Range("C1").Activate
    ActiveSheet.Unprotect
' Empieza el traslado de los registros sin filas en blanco
Set datos = Range("a320").CurrentRegion
Set datos = datos.Rows(1).Resize(149, datos.Columns.Count)

Set origen = datos.Offset(1, 0).Resize(datos.Rows.Count - 1, datos.Columns.Count)
Range("a500").Resize(origen.Rows.Count, origen.Columns.Count).ClearContents
Set destino = Range("a500").Resize(origen.Rows.Count, origen.Columns.Count)
ReDim matriz(datos.Rows.Count, datos.Columns.Count)

a = 1
For Each Fila In origen.Rows
    fil = Fila.Row - origen.Row + 1
    f = Fila
    If f(1, 4) = Empty Then GoTo siguiente
    
    For i = 1 To origen.Columns.Count
        matriz(a, i) = f(1, i)
    Next i
    a = a + 1
siguiente:
Next Fila

Range(destino.Address) = matriz
origen.Rows(0).Copy destino.Rows(0)
'destino.Select
' Protege la hoja
 Cells.Select
    Range("C1").Activate
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Habilita campos de Nombre Px y Tratamientos
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

SEGUNDA MAGRO - BOTON COPIAR REGISTROS DE UNA HOJA A LA BASE DE DATOS EXTERNA

Sub copia2()
' Desabilita los campos de Nombre Px y Tratamiento
    Application.EnableEvents = False
    Application.ScreenUpdating = False
' Desprotege la hoja
Cells.Select
    Range("C1").Activate
    ActiveSheet.Unprotect
Set hd = Workbooks("0. Base_Datos_Acumulada.xlsm")
Set destino = hd.ActiveSheet.Range("a1").CurrentRegion

Set ho = ActiveWorkbook
Set origen = ho.ActiveSheet.Range("a500").CurrentRegion

c = origen.Rows(1).Interior.ColorIndex

If c = 15 Then
    Set origen = origen.Rows(2).Resize(origen.Rows.Count - 1, origen.Columns.Count)
End If

origen.Copy destino.Rows(destino.Rows.Count + 1)
' Protege la hoja
 Cells.Select
    Range("C1").Activate
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Habilita campos de Nombre Px y Tratamientos
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

No tengo palabras para agradecerle todo lo que me ha aguantado, he aprendido, pero cada vez veo que se menos.

 

Muchas gracias y mil gracias.

 

0. Base_Datos_Acumulada - copia.xlsm

 

Dr Hyde Novato

Dr Hyde

publicado
publicado

con un boton basta para correr las dos macros solo haz esto por cada boton que tengas por hoja

Private Sub CommandButton2_Click()
copiar

copia2
End Sub

abajo de tus mensajes hay 3 botones seleccion opciones, borrar y listo

Oscar Arroyave Novato

Oscar Arroyave

publicado
  • Autor
publicado

Buenas tardes, es la siguiente:

1. Cuando copio las filas no me quedan con el formato que viene la base de datos

2. Tengo dos botenes, asi como me lo explicaste, 

  • El primero "Copiar" y copia las filas sin ninguna en blaco
  • El segundo "Copia2" que pasa los registros a la Base de Datos Externa.

La pregunta es, se puede hacer en uno solo?

Gracias nuevamente, en verdad sos un verdadero genio, lo felicito.

Dr Hyde Novato

Dr Hyde

publicado
publicado

para el formato y ya no moverle a las macros copia esta macro donde tienes las dos macros para copiar, esta le daran formato en el libro de acumulados

Sub formato()
Set hd = Workbooks("0. Base_Datos_Acumulada - copia.xlsm")
Set destino = hd.Sheets(1).Range("a1").CurrentRegion
    
    destino.Borders(xlDiagonalDown).LineStyle = xlNone
    destino.Borders(xlDiagonalUp).LineStyle = xlNone
    With destino.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With destino.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With destino.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With destino.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With destino.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With destino.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub
 

Dr Hyde Novato

Dr Hyde

publicado
publicado

la segunda en el boton copiar, añade el siguiente codigo y tendras en un solo boton las tres macros

Private Sub CommandButton2_Click()
copiar

copia2

formato
End Sub

Oscar Arroyave Novato

Oscar Arroyave

publicado
  • Autor
publicado

Gracias Dr. Hyde, procederé a realizar esto para cerrar el tema, que pena con usted, molestarlo tanto, pero he aprendido mucho, aunque me falta cantidades.

Nuevamente Gracias y mil Gracias.

Le comentare como me fue.

 

Oscar Arroyave Novato

Oscar Arroyave

publicado
  • Autor
publicado

Dr. Hyde, buenos días

Realice lo que me escribió y funciono perfecto, pero hay un detalle, los campos o celdas que tienen numeros enteros, separados de dos decimales, no quedan con el formato, es decir:

77,999 queda 77999

Las columnas son de la "J" a la "AD"

En cambio de de la "AJ" a la "AM" si quedan con el formato de miles.

Porque? no se, analice la Macro y no veo el motivo.

Te relaciono la Macro por si ves donde esta el porque copia unas columnas con formato de miles y las otras no:

Option Base 1
Sub copiar()
' Desabilita los campos de Nombre Px y Tratamiento
    Application.EnableEvents = False
    Application.ScreenUpdating = False
' Desprotege la hoja
Cells.Select
    Range("C1").Activate
    ActiveSheet.Unprotect
' Empieza el traslado de los registros sin filas en blanco
Set datos = Range("a320").CurrentRegion
Set datos = datos.Rows(1).Resize(149, datos.Columns.Count)

Set origen = datos.Offset(1, 0).Resize(datos.Rows.Count - 1, datos.Columns.Count)
Range("a500").Resize(origen.Rows.Count, origen.Columns.Count).ClearContents
Set destino = Range("a500").Resize(origen.Rows.Count, origen.Columns.Count)
ReDim matriz(datos.Rows.Count, datos.Columns.Count)

a = 1
For Each Fila In origen.Rows
    fil = Fila.Row - origen.Row + 1
    f = Fila
    If f(1, 4) = Empty Then GoTo siguiente
    
    For i = 1 To origen.Columns.Count
        matriz(a, i) = f(1, i)
    Next i
    a = a + 1
siguiente:
Next Fila

Range(destino.Address) = matriz
origen.Rows(0).Copy destino.Rows(0)
'destino.Select
' Protege la hoja
 Cells.Select
    Range("C1").Activate
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Habilita campos de Nombre Px y Tratamientos
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
 

De resto funciono perfectamente, estoy muy contento, pero si no se puede Dr, tranquilo, no sabes como me ayudo, y cada vez lo pulo màs, pero con la ayuda de ustedes, porque solo era imposible hacerlo.

Gracias

Dr Hyde Novato

Dr Hyde

publicado
publicado

en la macro formato antes del end sub coloca estas instrucciones

Set destino = destino.Offset(1, 9).Resize(destino.Rows.Count - 1, 21)
destino.NumberFormat = "#,##0"

deja los numeros tal como quieres

Oscar Arroyave Novato

Oscar Arroyave

publicado
  • Autor
publicado

Dr. Hyde, buenas tardes

Quedo EXCELENTE, funciona a la perfección.

Todos los formatos quedaron "Ok"

La copia de los registros en la Base de Datos Externa los copia muy bien.

Gracias, muchisimas gracias.

Verdaderamente el que sabe, sabe, lo Felicito.

 

PODEMOS DAR POR TERMINADO ESTE TEMA

Disculpeme si lo moleste demasiado, pero sin usted nunca lo habría realizado.

Gracias

Oscar Arroyave Novato

Oscar Arroyave

publicado
  • Autor
publicado

Dr Hyde, no crea que le escribo solo para que me ayude, también para FELICITARLO y agradecerle que me ha soportado tanto.

Como escribí anteriormente podemos dar por Cerrado este Tema.

Voy a continuar mejorando la hoja, ahora quiero que cuando se posicione en el nombre tome una Base de datos de Nombre, lo voy a intentar hacer.

 

Gracias nuevamente

  • Silvia bloqueó este tema

Archivado

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

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Current Donation Goals

    • Mantenimiento de la comunidad
      Raised 0.00 EUR of 130.00 EUR target

  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      28
    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Un juego del Rabino en Excel
    Por pegones1

    1    1

  • Crear macros Excel

  • Mensajes

    • Enrique González Jiménez
      Ayuda con Congelar Fecha Captura

      Por Enrique González Jiménez · publicado

      Vale mil gracias, en vdd se agradece todo el apoyo y comentarios
    • Abraham Valencia
      Problema (¿Macro?) para guardar Excel en SharePoint

      Por Abraham Valencia · publicado

      Hola nuevamente. Por eso la importancia de lo que mencionas tú como "ruta relativa". Tal cual comentas, y aún sin llegar a algunos detalles importantes para ayudarte, en realidad tal cual te comenté le día miércoles, pues sí podías hacer como comentabas, era cosa de obtener los Id de Windows (como tú los llamas) y la ruta de OneDrive en casa usuario y eso sí se puede obtener con VBA y luego pasarlo a PQ, pero medio que te cerraste en que "PQ no puede trabajar con rutas relativas", cosa cierta pero siempre hay formas. Si SAP puede o no guardar en OneDrive o SharePoint, pues si está mapeado en la PC ¡claro que se puede! Pero bueno, creo que si te es útil tu propia propuesta ¡avanza con eso!
    • njnsp
      Problema (¿Macro?) para guardar Excel en SharePoint

      Por njnsp · publicado

      Perdona @Abraham Valencia pero he estado liado estos días. En realidad todo el problema se reduce a estos dos problemas: Problema 1: El script que "fabrica" SAP y que luego "pego" en la macro, no es capaz de  guardar archivos en SharePoint. He estado buscando, y en realidad muchas personas tienen ese problema (no poder guardar un Excel en SAP a través de VBA). Eso muy probablemente sean problemas de permisos, que no puedo cambiar (no soy administrador de nada). Como no puedo solucionarlo así, paso al plan B, que es guardar en Excel que me genera SAP en el ordenador de cada usuario que ejecute la plantilla (y que sí está guardada en SharePoint), para después con PowerQuery llamar a ese Excel (el export). Para ello, pretendo guardar el export, en la ruta relativa "C:\..\..\..\OneDrive - NombreEmpresa\Documentos\SAP\SAP GUI" donde los \..\..\..\ saltan las rutas personales de cada usuario (tipo C:\users\IDusuario\). Eso lo hace bien, y el archivo se guarda en la ruta de cada usuario que lo usa, pero surge el problema 2 Problema 2: PowerQuery no trabaja con rutas relativas del tipo  "C:\..\..\..\OneDrive - NombreEmpresa\Documentos\SAP\SAP GUI" necesita que sea del tipo fija "C:\users\IDusuario\OneDrive - NombreEmpresa\Documentos\SAP\SAP GUI" pero claro, IDusuario es diferente para cada usuario.   Pero escribiendo todo esto, creo que he dado con una posible solución, no grabar el export en una ruta de usuario, sino en una en la raiz de C:, que siempre será igual para todos los usuarios, del tipo C:\Sap\export.xlsx que seria igual en todos los ordenadores. Asi sí podría decirle a PowerQuery que vaya siempre a la ruta C:\Sap\ que existirá en todos los ordenadores. Mañana intentaré hacer pruebas, aunque mi solución ideal seria que se pudiera guardar en el SharePoint. Saludos.
    • DiegoPC
      Planilla Mercado Pago

      Por DiegoPC · publicado

      Hola La opción brindada por @torquemada es correcta, funciona, pero hay algunos inconvenientes que (desde mi punto de vista) no la convierten en mi primera elección. Los inconvenientes son: Tendrías que ir columna por columna haciendo los reemplazos, claro que no se harían a mano sino que utilizarías la opción reemplazar o la opción texto en columnas, aun asi demorará un poquito y será trabajoso. Cada vez que descargues otro listado, tendrás que volver a realizar los reemplazos. Me parece una mejor propuesta lo siguiente: Descarga los movimientos a un archivo de Excel Desde tu control de pagos (otro archivo) cargas los movimientos del archivo descargado mediante Power Query Power Query hará los reemplazos y reconocerá todo correctamente (sin que tengas que hacer nada especial) Cuando descargues los movimientos un día posterior, solamente tendrás que hacer clic en "Actualizar" y todo funcionará en automático
    • Victor7
      Ayuda con Congelar Fecha Captura

      Por Victor7 · publicado

      Hola a todos, Efectivamente, me temo que tal como trabajan las funciones =HOY() y/o =AHORA() (volátiles), sólo con macros puedes obtener soluciones. Un recurso pedestre podría ser, cada vez que quieras que se fije un dato, te sitúes en esa celda y pulses F2, F9 e INTRO.  Pero claro, puede ser un inconveniente si hay que hacerlo repetitivamente en muchas ocasiones,.............. en fin, lo comento sólo como posibilidad. Saludos,

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • 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.