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

[Oscar Arroyave]

Buenas tardes a todos, necesito una ayuda para copiar un rango de filas  de una hoja a un archivo externo(Base de Datos), la situacion es la siguiente:

1. Un archivo tiene varias hojas, numeradas del 1 al 30, que son los dias del mes, en este caso el ejemplo es 1,2.

2. En cada hoja hay unas filas, o sea registros del dia, estan de la fila 500 hasta máximo la fila 649, pueden ser menores, o sea, un dia puede ser de la 500 a la 510, otro de la 500 a la 520, así sucesivamente.

3. Estos registros los debo copiar a Una Base de Datos Externa, o sea, adicionarlos dia a dia, es decir buscar el ultimo registro de la base de datos externa y copiarlos al final.

4. Lo deseo hacer por una Macro

 

Lo he intentado y no me sale siguiendo el procedimiento de crear una macro automática.

 

Les agradeceria si pudieran colaborarme.

 

Adiciono un ejemplo de dos dias con unos datos de prueba, no coloco la Base de Datos para ver como se puede crear desde cero.

 

Agradeciéndoles la colaboración

 

Prueba Copia de Registros sin Filas en Blanco.xlsm

[Dr Hyde]

te falta explicar una cosa, la base externa es access?, otra hoja de excel? o lo quieres copiar con determinado formato para subirlo a una base de datos de un sistema?, te lo digo porque dependiendo del tipo de base externa es la programacion que se hace.

[Oscar Arroyave]

No, solo es una hoja en excel donde deseo ir acumulando los registros dia a dia, para después trabajarlos por tablas dinámicas.

Gracias

[Dr Hyde]

checa la macro pero primero corre la macro para copiar quitando filas vacias, le hice un cambio que es necesario para que esta macro funcione.

Prueba Copia de Registros sin Filas en Blanco (2).rar

[Oscar Arroyave]

Dr. Hyde, usted siempre tan amable, la macro que me envio esta funcionando pero lo que yo necesito es parecido, de pronto no clarifique bien el asunto, pero lo que necesito es lo siguiente:

1. En la hoja "1" se genera los registros del día "1" después de la linea 500, esto funciona perfecto con la macro.

2. En la hoja "2" se genera los registros del día "2" después de la línea 500, esto funciona perfecto con la macro.

3. Necesito es en un archivo independiente, no una hoja o pestaña que este dentro del archivo del movimiento día a día, en el cual se acumule la información generada cada día.

Es decir el archivo que tienes en este momento con las pestañas "1" y "2" y otro archivo totalmente diferente que se llame Base_Datos, en el cual deseo que al terminar cada día corra una Macro que lleve los registros al Archivo Base_Datos.

No se si fui claro, o si el procedimiento es muy difícil, en este momento lo que hago es corro la Macro que me genera los registros sin filas vacias y manualmente los copio a la Base_Datos, día a día.

 

Gracias nuevamente y que pena molestarlo.

[Dr Hyde]

la macro funciona asi, creas un libro de excel llamado base de datos o si ya la tienes con un mobre diferente solo modificas esta linea

Set libro = Workbooks("base de datos.xlsm").Sheets("hoja1")

corres la macro copiar, le hice algunas modificaciones para que los datos se copien completos, luego click en el boton resumir que mandara toda la informacion de las hojas a la base de datos.

Nota: los 2 libros tienen que estar abiertos para que funcione la macro sino te va a poner un error 9

Prueba Copia de Registros sin Filas en Blanco (2).rar

[Oscar Arroyave]

Dr. Hyde, buenas tardes

1. Cree el archivo "Base de Datos" en blanco, en el directorio "E:\Dermes\prueba\

2. Copie en este mismo directorio el archivo donde estan la "hoja 1" y la "Hoja 2"

3. Corrí la macro que genera los registros sin filas en blanco tanto en la Hoja 1 y la Hoja 2, funciono perfecto.

4. Corrí la Macro "Resumir" y me genera error en la siguiente línea:

Sub acumular()
Set libro = Workbooks("base de datos.xlsm").Sheets("hoja1")

For Each hoja In Worksheets
    n = hoja.Name
    Set origen = Worksheets(n).Range("a499").CurrentRegion
    Set destino = libro.Range("b5").CurrentRegion
    
    filas = destino.Rows.Count: columnas = destino.Columns.Count
    
    If filas = 1 And columnas = 1 Then
        origen.Copy destino
    Else
        Set origen = origen.Rows(2).Resize(origen.Rows.Count - 1, origen.Columns.Count)
        origen.Copy destino.Rows(destino.Rows.Count + 1)
    End If
    
Next hoja
End Sub

5. Pregunta: La Macro "Resumir" la necesito correr todos los días, o sea, debe estar incluida en cada hoja para pasar la información del día a día, no que sea una acumulable, es decir que copie todos los registros de todos los días en la Base de Datos. Espero que me haya explicado bien y disculpa
 

[Dr Hyde]

tienes que tener los dos libros abiertos para que la macro funcione (el error se da porque el libre base de datos esta cerrado), el libro base de datos y el libro donde tienes los archivos diarios, la macro la hice en el de los archivos diarios porque desconozco como se llama el archivo original, si me lo das modifico la macro para que el boton funcione desde el libro base de datos.

[Oscar Arroyave]

Dr. Hyde, que pena con usted, la información es la siguiente:

1. El archivo se llama "Seguimiento Px"

2. Como me dijiste cree el archivo "Base de datos" para realizar la prueba, y lo tengo abierto, el asunto es, en que directorio debo tener los archivos tanto de los registros diarios como el de Base de Datos.

3. Cuando corra la macro día a día, el me anexa al ultimo registro donde vaya?

4. Esta instrucción que es lo que hace en sí?

Set libro = Workbooks("base de datos.xlsm").Sheets("hoja1")

 

Gracias por toda tu colaboración.

 

[Oscar Arroyave]

Dr. Hyde, este es el error que me sale

"Se ha producido el error "9" en tiempo de ejecución

Subindice fuera del intervalo.

 

Gracias

 

[Dr Hyde]

no importa en que directorio tengas los archivos, la macro trabaja con los archivos abiertos, error 9 significa que no existe la hoja o bien que la hoja en cuestion no tiene nada que copiar, ya con esa info dejame modificar la macro

 

[aaquino]

Sin ver archivos ni nada, se me hace que el error es este:

Set libro = Workbooks("base de datos.xlsm").Sheets("hoja1")

Cree el archivo "Base de Datos" en blanco, en el directorio "E:\Dermes\prueba\

De seguro, el compañero @Oscar Arroyave creó el archivo así: "Base de Datos.xlsx", cuando lo debió crear así: "Base de Datos.xlsm"

Lo que debes hacer @Oscar Arroyave es cambiar la extensión del Archivo Base de Datos a ".xlsm"

[Dr Hyde]

subo el archivo en dos parte porque no se permite mas de 100 kb, aqui va la primera parte, esta macro es la que debes ocupar para las copias diarias sino la segunda macro no funcionara

Seguimiento Px.rar

[Oscar Arroyave]

Es correcto, lo cree con extension .xlsx

[Dr Hyde]

esta es la segunda parte, solo das click al boton y te hace la copia de todas las hojas del libro seguimiento al libro base de datos, se va a mover enntre hojas y va a colocar la informacion abajo del ultimo renglon que encuentre en la hoja base de datos, esta macro no valida directorios ni nada solo trabaja con los dos libros abiertos

base de datos.xlsm

[Oscar Arroyave]

Dr. Hyde, muchas gracias, le explico lo que me sta sucediendo:

1. Esta es la Macro que copie en el Archivo donde tego acumulado todos los registros de este año, total 34.202

Sub acumular()
Set libro = Workbooks("0. Base_Datos_Acumulada.xlsm")

For Each hoja In libro.Worksheets
    Set destino = Range("a5").CurrentRegion
    f = destino.Rows.Count: c = destino.Columns.Count: nombre = hoja.Name
    Set origen = libro.Worksheets(nombre).Range("a499").CurrentRegion
    If f = 1 And c = 1 Then
        origen.Copy destino
    Else
        origen.Rows(2).Resize(origen.Rows.Count - 1, origen.Columns.Count).Copy destino.Rows(destino.Rows.Count + 1)
    End If
    nombre = hoja.Name
    
Next hoja
destino.EntireColumn.AutoFit
End Sub

2. Abrí el archivo del mes de Julio donde estan dia a dia el movimiento que se genero por la macro que copia los registros de la fila 500 en adelante por cada día.

3. Se desprotegieron las hojas porque de lo contrario me genera error.

4. Corri la macro "Acumular desde el archivo ("0. Base_Datos_Acumulada.xlsm")

5. No saco error, pero tampoco me genero o adiciono los registros despues de la fila 34.202, porque?

6. Aprovechandome de su generosidad, lo que necesito es que en cada dia se corra una Macro, que copie los registros de ese día al archivo ("0. Base_Datos_Acumulada.xlsm"). Yo me había equivocado al decirle otro nombre, me disculpo.

Espero que me haya explicado bien, y me vuelvo a disculpar

Muchas gracias y perdonen por ser tan cansón, pero verdaderamente no se como hacerlo.

 

 

[Dr Hyde]

ya me confundi, dices:  Abrí el archivo del mes de Julio donde estan dia a dia el movimiento que se genero por la macro que copia los registros de la fila 500 en adelante por cada día, como se llama el archivo del mes de julio?

a ver para dejar las cosas claro:

el archivo donde tienes los datos que quieres copiar se llama?,

y el archivo donde vas a pegar los datos se llama?,

verifica la hoja base de datos creo que ya no tienes 32000 sino mas de 64000, con el cambio que hiciste creo que eso paso.

[Oscar Arroyave]

Buenas noches Hyde, gracias por responderme, estas son las respuestas:

1. Archivo donde tengo los datos dia a dia: ("7. Planilla Diaria-Julio")

2. Archivo adonde se deben de copiar los registros día a día, o sea el Acumulado: ("0. Base_Datos_Acumulada.xlsm")

3. Observe la Base de Datos acumulada y me siguieron los mismos registros.

 

Gracias por toda tu colaboración.

[Dr Hyde]

bien en el archivo  "0. Base_Datos_Acumulada.xlsm" copias la macro del libro base de datos que te mande, luego entras a la programacion y cambias esta linea

Set libro = Workbooks("0. Base_Datos_Acumulada.xlsm")  o

Set libro = Workbooks(" pacientes sx.xlsm")

por esta otra

Set libro = Workbooks("7. Planilla Diaria-Julio.xlsm"), verifica la extension y pones la que tenga el archivo xls si es xls o xlsm si es xlsm

set libro le indica a la macro de que archivo va a copiar los datos

cambia

set destino= Set destino = Range("a5").CurrentRegion, la referencia "a5", cambiala por la primera celda donde empiecen los datos en esa hoja, con eso deberia de funcionar la macro.

esta instruccion le indica la region donde va a pegar los datos.

Nota: como estas haciendo pruebas antes de correr la macro haz un respaldo de tu informacion.

en el archivo "0. Base_Datos_Acumulada.xlsm" pones el boton para activar la macro, si corres la maro desde VBA asegurate de que el archivo "0. Base_Datos_Acumulada.xlsm" este activo.

de nuevo ambos archivos deben estar abiertos.

[Oscar Arroyave]

Buenos días Dr. Hyde, que Macro tan dificil para mi, estos fue lo que realice:

1. Macro copiada en el Archivo  "0. Base_Datos_Acumulada.xlsm"

Sub acumular()
Set libro = Workbooks("7. Planilla Diaria-Julio.xlsm")

For Each hoja In libro.Worksheets
    Set destino = Range("a2").CurrentRegion
    f = destino.Rows.Count: c = destino.Columns.Count: nombre = hoja.Name
    Set origen = libro.Worksheets(nombre).Range("a499").CurrentRegion
    If f = 1 And c = 1 Then
        origen.Copy destino
    Else
        origen.Rows(2).Resize(origen.Rows.Count - 1, origen.Columns.Count).Copy destino.Rows(destino.Rows.Count + 1)
    End If
    nombre = hoja.Name
    
Next hoja
destino.EntireColumn.AutoFit
End Sub

2. Al ejecutar la Macro, me sale el siguiente error:

"Se ha producido el error '1004' en tiempo de ejecución

Error definido por la aplicación o el objeto

3. Dr.  la Macro funcionaría de la siguiente manera: tomaría los datos de la fila 500 en adelante de todas las hojas del archivo ("7. Planilla Diaria-Julio.xlsm") y los copiaría al ("0. Base_Datos_Acumulada.xlsm") que es donde tengo todos los registros acumulados?

4. Pero lo que necesito Dr. Hyde, es que estando en la planilla ("7. Planilla Diaria-Julio.xlsm"), supongamos el dia "1", esos solos datos de ese día, sean los que se pasen para el archivo acumulado.

Despues entro al día "2" y terminado el día ejecutará la macro, pero esta vez que solo me copie los datos del día "2" ar archivo acumulado.

Y así sucesivamente.

 

Espero que haya sido claro, y nuevamente me disculpo.

Gracias por todo su apoyo.

 

 

[Dr Hyde]

puedes subir un extracto del archivo 0. Base_Datos_Acumulada.xlsm, copia solo los primeros 10 renglones y esos sube solo para saber como esta la estructura de tus datos y sobre ese archivo hacer la macro

 

[Oscar Arroyave]

Dr. Hyde, Buenos días

Adjunto el archivo con varios registros solicitados.

Esa es la estructura de mis datos.

Gracias

 

 

0. Base_Datos_Acumulada - copia.xlsm

[Dr Hyde]

esta macro copia una hoja a la vez lo unico que tienes que hacer es agregar un boton a cada hoja donde la vayas a usar, necesitas tener los dos libros abiertos, ya con el nombre real del archivo debe funcionar.

Sub copia2()
Set hd = Workbooks("0. Base_Datos_Acumulada - copia.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)

End Sub

Prueba Copia de Registros sin Filas en Blanco (2).rar

[Oscar Arroyave]

Dr Hyde, buenas tardes, gracias por la respuesta, mire lo que me sucede, se que debe ser algo insignificante, pero no doy con lo que me sucede:

1. Cree un botón en cada Hoja, el cual tiene la macro que me detallo.

2. Abri el Archivo  ("0. Base_Datos_Acumulada - copia.xlsm"), desprotegido

3. Ejecute la Macro, no me genero error, pero fui a mirar el archivo y no me copio dos registros que tenia de prueba desde la fila 500 y 501.

4. Para descartar o mirar que si funcionara todo, entonces Ejecute la El Botton que usted me envio que dice "Resumir"

5. Y este si copia los registros al archivo ("0. Base_Datos_Acumulada - copia.xlsm")

6. Procedí entonces a Copiar ese botón Resumir a mi archivo original donde hago las prueba, lo ejecuta y no me hace nada, porque sera?

Gracias, disculpe en verdad tanta molestia, pero comparo todo y no veo diferencia.

 

[Oscar Arroyave]

Dr. Hyde, buenas tardes

No se si le sirven estos datos adicionales:

1. Cuando Ejecuto el Botón "Resumir" desde el archivo que se tiene como prueba ("Prueba Copia de Registros sin Filas en Blanco (2)") funciona perfectamente desde la "Hoja 1" o desde la "Hoja2"

2. El Archivo que estoy trabajando se llama "(8. Planilla Diaria-Agosto.Xlsm")

3. La hoja esta con el nombre de "1"

4. Hay dos registros el las filas 500 y 501

 

Ojala te sirvan para mirar porque no me los copia.

 

Gracias nuevamente