Macro para extracción de datos de dos hojas

buen dia tengo una macro que me extrae los datos de una sola hoja "DURO", necesito saber si se puede hacer algo ara que me traiga información de dos hojas al mismo tiempo. Los datos se vacían en la hoja "Datos". Necesito extraer datos de otra hoja llamada "frágil"

que es semejante en estructura.

Private Sub solución(pOrigenWorkbook As Workbook)
Dim sFecha() As String
Dim Fecha As Date
Dim numHojas As Integer
Dim j As Integer
Dim f As Integer
Dim numFila As Integer
Dim numRenglon, numRenglon1 As Integer
Dim OrigenWorkbook As Workbook
Dim OrigenWorkSheet As Worksheet
Dim DestinoWorkSheet As Worksheet
Set OrigenWorkbook = pOrigenWorkbook
OrigenWorkbook.Sheets("DURO").Activate
OrigenWorkbook.Sheets("DURO").Columns("A:C").Insert Shift:=xlToRight
OrigenWorkbook.Sheets("DURO").Range("K6").Select
numRenglon = OrigenWorkbook.Sheets("DURO").Range(Selection, Selection.End(xlDown)).Count
numRenglon1 = numRenglon - 5
OrigenWorkbook.Sheets.Add After:=OrigenWorkbook.Sheets(OrigenWorkbook.Sheets.Count)
OrigenWorkbook.Sheets(OrigenWorkbook.Sheets.Count).Name = "Datos"
Set DestinoWorkSheet = OrigenWorkbook.Sheets("Datos")
DestinoWorkSheet.Range("A1").Value = "FECHA"
DestinoWorkSheet.Range("B1").Value = "INSTALACIÓN"
DestinoWorkSheet.Range("C1").Value = "INJ1"
DestinoWorkSheet.Range("D1").Value = "INJ2"
DestinoWorkSheet.Range("E1").Value = "EXI1"
DestinoWorkSheet.Range("F1").Value = "EXI2"
DestinoWorkSheet.Range("G1").Value = "REC|"
DestinoWorkSheet.Range("H1").Value = "REC2"
For numHojas = numRenglon1 To numRenglon + 5
j = numHojas
OrigenWorkbook.Sheets("DURO").Range("B" & numHojas).FormulaLocal = "=(TEXTO(E" & j & ",""mm/dd/yyyy""))"
Fecha = OrigenWorkbook.Sheets("DURO").Range("B" & numHojas).Value
Next
numFila = 1
For numHojas = numRenglon1 To numRenglon + 5
OrigenWorkbook.Sheets("DURO").Range("B" & numHojas).NumberFormat = "dd/mm/yyyy"
Fecha = OrigenWorkbook.Sheets("DURO").Range("B" & numHojas)
numFila = numFila + 1
DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
DestinoWorkSheet.Range("B" & numFila).Value = "REBO1"
DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("DURO").Range("H" & numHojas).Value
DestinoWorkSheet.Range("E" & numFila).Value = OrigenWorkbook.Sheets("DURO").Range("K" & numHojas).Value
numFila = numFila + 1
DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
DestinoWorkSheet.Range("B" & numFila).Value = "REBO2"
DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("DURO").Range("I" & numHojas).Value
numFila = numFila + 1
DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
DestinoWorkSheet.Range("B" & numFila).Value = "SAL"
DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("DURO").Range("M" & numHojas).Value
DestinoWorkSheet.Range("E" & numFila).Value = OrigenWorkbook.Sheets("DURO").Range("N" & numHojas).Value
Next

1 Respuesta

Respuesta
1

¿Quieres extraerlos de frágil y también vaciarlos en Datos?
Si es así.
Copia toda la macro desde
Dim sFecha() As String
Y hasta
Next
Después, en las líneas copiadas tienes que reemplazar, en cada línea, que tenga la palabra “DURO” por la palabra “frágil”.
Nota: al final de la macro te debe quedar la línea End Sub
Listo, pruébala y me dices.
Saludos. Dam

buen dia

realize su respuesta pero me marco un arror, acerca de la variable : Dim sFecha() As String que se encontraba repetida

Entonces, por favor, todas las siguientes líneas en la parte copiada, deberás borrarlas.

Dim sFecha() As String
Dim Fecha As Date
Dim numHojas As Integer
Dim j As Integer
Dim f As Integer
Dim numFila As Integer
Dim numRenglon, numRenglon1 As Integer
Dim OrigenWorkbook As Workbook
Dim OrigenWorkSheet As Worksheet
Dim DestinoWorkSheet As Worksheet

Prueba y me dices.

Saludos. Dam

buen dia he realizado lo que me dices pero me manda un error , crea un conflicto por que trata de insertar en la misma hoja los nuevos datos , amanera de chequeo cambie el nombre de de la hoja destino "Datos" por Datos2 y si lo ha realizado pero en una nueva hoja

Borra la copia que hiciste y pega en su lugar lo siguiente

OrigenWorkbook. Sheets("FRAGIL"). Activate
OrigenWorkbook.Sheets("FRAGIL").Columns("A:C").Insert Shift:=xlToRight
OrigenWorkbook.Sheets("FRAGIL").Range("K6").Select
numRenglon = OrigenWorkbook.Sheets("FRAGIL").Range(Selection, Selection.End(xlDown)).Count
numRenglon1 = numRenglon - 5
OrigenWorkbook.Sheets.Add After:=OrigenWorkbook.Sheets(OrigenWorkbook.Sheets.Count)
OrigenWorkbook.Sheets(OrigenWorkbook.Sheets.Count).Name = "Datos"
Set DestinoWorkSheet = OrigenWorkbook.Sheets("Datos")
ufila = DestinoWorksheets.Range("A" & Rows.Count).End(xlUp).Row
For numHojas = numRenglon1 To numRenglon + 5
j = numHojas
OrigenWorkbook.Sheets("FRAGIL").Range("B" & numHojas).FormulaLocal = "=(TEXTO(E" & j & ",""mm/dd/yyyy""))"
Fecha = OrigenWorkbook.Sheets("FRAGIL").Range("B" & numHojas).Value
Next
numFila = ufila + 1
For numHojas = numRenglon1 To numRenglon + 5
OrigenWorkbook.Sheets("FRAGIL").Range("B" & numHojas).NumberFormat = "dd/mm/yyyy"
Fecha = OrigenWorkbook.Sheets("FRAGIL").Range("B" & numHojas)
numFila = numFila + 1
DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
DestinoWorkSheet.Range("B" & numFila).Value = "REBO1"
DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("H" & numHojas).Value
DestinoWorkSheet.Range("E" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("K" & numHojas).Value
numFila = numFila + 1
DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
DestinoWorkSheet.Range("B" & numFila).Value = "REBO2"
DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("I" & numHojas).Value
numFila = numFila + 1
DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
DestinoWorkSheet.Range("B" & numFila).Value = "SAL"
DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("M" & numHojas).Value
DestinoWorkSheet.Range("E" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("N" & numHojas).Value
Next

Saludos.dam

Realize lo sugerido y aun me envía el mismo error . de un conflicto por colocar el mismo nombre a la hoja destino que para este caso se llama "Datos" , noce me ocurreo otra solución para este problema, agradezco su valiosa ayuda espero sus comentarios

Perdona por los intentos fallido, en la macro copiada, cambia todas las palabras que digan

DestinoWorkSheet

Por

DestinoWorkSheet2

buen dia , al contrario no ahy nada que disculpar tu ayuda es invaluable, mira seguí tus instrucciones , peor no corrió me envío un error porque no había declarado

DestinoWorkSheet2, lo declare y aun asi seguí en lo mismo, después me di cuenta que al correr la macro no activo nuevamente la hoja "Datos", asi que lo hice

OrigenWorkbook.Sheets("Datos").Activate

esto logro acer que por fin entrara a leer el archivo sin darme el error de conflicto de nombres , pero me marco un error de rango y fue por que tengo un encabezado con una celda , combinada lo corregí:

OrigenWorkbook.Sheets("LIGERO").Range("I8").Select

corrí de nuevo y me envío el error de conflicto de nombres, en esta parte estoy atorado creo que ya va por buen camino porque ha entrado al archivo por fin , pero esta instrucción:

OrigenWorkbook.Sheets.AddAfter:=OrigenWorkbook.Sheets(OrigenWorkbook.Sheets.Count)
OrigenWorkbook.Sheets(OrigenWorkbook.Sheets.Count).Name = "Datos"

creo que crea de nuevo la hoja y me imagino que ya no debería crearla puesto que ya estaba creada al correr la parte de la mAcro "DURO" y como estoy creando una que se llama igual imagino que ese es el error.

las elimine esas lineas al creer que esto solucionaría el error :) , pero me envío nuevamente un error de rango y hasta hy me quede,he supuesto que es en esta parte :

ufila = DestinoWorkSheet2.Range("A" & Rows.Count).End(xlUp).Row

pero no estoy seguro :(

Agradeceré nuevamente tus comentarios , saludos

Mandame tus archivos para probar la macro

[email protected]

Saludos. Dam

hola ya te envíe un mail con los datos

Perdona los inconvenientes.

Te mando la parte de Frágil

'inicia fragil
    OrigenWorkbook. Sheets("FRAGIL"). Activate
    OrigenWorkbook.Sheets("FRAGIL").Columns("A:C").Insert Shift:=xlToRight
    OrigenWorkbook.Sheets("FRAGIL").Range("K6").Select
    numRenglon = OrigenWorkbook.Sheets("FRAGIL").Range(Selection, Selection.End(xlDown)).Count
    numRenglon1 = numRenglon - 5
    'OrigenWorkbook.Sheets.Add After:=OrigenWorkbook.Sheets(OrigenWorkbook.Sheets.Count)
    'OrigenWorkbook.Sheets(OrigenWorkbook.Sheets.Count).Name = "Datos"
    Set DestinoWorkSheet = OrigenWorkbook.Sheets("Datos")
    ufila = DestinoWorkSheet.Range("A" & Rows.Count).End(xlUp).Row
    For numHojas = numRenglon1 To numRenglon + 5
    j = numHojas
    OrigenWorkbook.Sheets("FRAGIL").Range("B" & numHojas).FormulaLocal = "=(TEXTO(E" & j & ",""mm/dd/yyyy""))"
    Fecha = OrigenWorkbook.Sheets("FRAGIL").Range("B" & numHojas).Value
    Next
    numFila = ufila
    For numHojas = numRenglon1 To numRenglon + 5
            OrigenWorkbook.Sheets("FRAGIL").Range("B" & numHojas).NumberFormat = "dd/mm/yyyy"
            Fecha = OrigenWorkbook.Sheets("FRAGIL").Range("B" & numHojas)
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "REBOMBEO L-1 A DB"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("H" & numHojas).Value
            DestinoWorkSheet.Range("E" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("K" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "REBOMBEO L-2 A DB"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("I" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "SALIDA A DB (NH-A)"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("M" & numHojas).Value
            DestinoWorkSheet.Range("E" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("N" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "13:30:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "SALIDA A DB (AKAL-C)"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("P" & numHojas).Value
            DestinoWorkSheet.Range("E" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("S" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "13:30:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "SALIDA HACIA NH-A"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("Q" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "16:30:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "SALIDA A AK-C (AKAL-J)"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("U" & numHojas).Value
            DestinoWorkSheet.Range("E" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("X" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "16:30:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "SALIDA A DB (AKAL-J)"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("V" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "17:30:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "SALIDA A DB VIA AK-C (L-1)"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("Z" & numHojas).Value
            DestinoWorkSheet.Range("E" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("AA" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "LINEA 1"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("AF" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "LINEA 2"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("AG" & numHojas).Value
            numFila = numFila + 1
            DestinoWorkSheet.Range("A" & numFila).Value = Fecha + "05:00:00"
            DestinoWorkSheet.Range("A" & numFila).NumberFormat = "mm/dd/yyyy"
            DestinoWorkSheet.Range("B" & numFila).Value = "TV-5007"
            DestinoWorkSheet.Range("C" & numFila).Value = OrigenWorkbook.Sheets("FRAGIL").Range("AH" & numHojas).Value
    Next
'Fin Fragil

quita la versión anterior de frágil y pon la nueva, ya no debes tener problemas, ya me funcionó.

Saludos. Dam

Pruébala y si es lo que necesitas.

Buen dia , épico. Solo un detalle que no he podido arreglar , los datos que me extrea solo lo ase del dia 1 de enero al 11 y me gustaría a ke fueran de todos los meses que traen la hoja , de ante mano muchas gracias

¿Pero ese problema dónde se presenta?

¿En duro o en frágil?

Tienes que revisar los datos que tienes en la columna K, si hay vacíos no va a llegar hasta el final, del renglón, rellena con ceros los vacíos que tienes en la columna K

Pruébala nuevamente y me dices

Saludos. Dam

El problema se presenta en frágil, solo ase los primeros 11 del mes de enero , se puede ver en la hoja datos que da como resultado el correr la macro.gracias

¿Ya hiciste lo que te comenté de revisar la columna K de frágil?

si lo cheque tengo celdas vacías días 14 y 15 , aunque los días 12 y 13 tineen datos pero estos no los coloca :(

Por eso, pon 0 en todas las celdas vacías de la columna K de frágil y lo vuelves a ejecutar

buen dia realiza su recomendación, ahora se corría 11 días de octubre a aunque están llenos lo sespacios vacíos con 0.

Pero eso hace la macro, incluso con Duro, porque así está diseñada,

For numHojas = numRenglon1 To numRenglon + 5

Con esa instrucción específica cuantos renglones debe copiar de duro o frágil a DATOS. Si quieres que corrija la macro tendrás que ser más específico, con ejemplos, para saber exactamente qué quieres que ahora haga la macro.

La primera ya se cumplió, que era copiar duro y frágil a DATOS

Saludos. Dam

BUEN DIA

gracias por tu pporntoa respuesta, tienes toda la razón, como seria para que nosolo seleccionara 11 sino toda la columna?

Tendrías que cerrar esta pregunta y crear una nueva, por favor.

Tienes que cambiar las siguientes líneas

numRenglon1 = numRenglon - 5

Por esta

numRenglon1 = 6

Esta
For numHojas = numRenglon1 To numRenglon + 5

Por esta

For numHojas = numRenglon1 To numRenglon

Esta

For numHojas = numRenglon1 To numRenglon + 5

Por esta

For numHojas = numRenglon1 To numRenglon

Saludos. Dam

Prueba y me comentas en la nueva pregunta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Textbox con fecha actual

Dado que tus anteriores respuestas me han sido de gran ayuda, me permito abusar de tus conocimientos: leí en otra consulta que para poner la fecha de hoy se usa el comando =Hoy(). Eso me funciona perfecto en excel. ¿Me puedes dar el código para que...
1 respuesta

Filtrar por fecha y mostrar en listbox de excel

Tengo un formulario con un listbox, un botón y dos textbox. Tengo en una hoja un rango de datos "x", entre ellos una columna que muestra la fecha para cada fila. Necesito ingresar en los textbox un rango de fechas, presionar el botón, y que en el...
1 respuesta

Citas Calendarios Personalizados VBA

Desde Office Excel podemos crear, establecer citas en éstos calendarios personalizados de una manera muy rápida, utilizando código Vba. Sin embargo vienen estas instrucciones pero no lo hacer que funcione: El método CreateItem utiliza la carpeta...
1 respuesta

Macro para filtrar entre fechas

Llevo unos días intentando filtrar algunos datos con fecha del mismo MES, mediante una macro y no hay manera. La idea es: Escribir en un recuadro el día 01/06/2011 y que me filtre los datos de otra hoja, seleccionando "mayor o igual que 01/06/2011" y...
1 respuesta

Macro para copiar celdas

Necesito una macro que me copie los datos de la celda B5 de la hoja 1 a la celda A2 de la hoja 2 lo que pasa es que los datos de la celda B5 me van cambiando y quiero que todos los datos se me vallan guardando en la celda A2, A3, A4, ... En fin en...
1 respuesta

Crear cronometro excel 2010

He estado intentando crear una macro para cronometrar con excel y no lo consigo, lo que necesitaría sería el cronometro en si, que cuando le de a un botón comience, con otro botón pare y con otro resetee a "0". También estoy intentando poner una...
1 respuesta

Macro filtrar rango fechas con textbox

Como puedo hacer para hacer un filtro de rango fechas entre 2 textbox. Ejemplo: textbox1=fecha1 textbox2=fecha2 el filtro que necesito es que la fecha1 sea mayor o =, y la fecha 2 se menor o =.
1 respuesta

Macro para filtrar con dos columnas

Tengo una macro para hacer un filtro en dos columnas, una en la que le doy el valor de filtrado por un textbox, y en la otra, por dos textbox con dos fechas (inicio y fin). Algo estoy haciendo mal por que no me funciona. La fecha la tengo en la...
1 respuesta

Insertar un carácter en una celda de excel

Me pudieran ayudar para agregar un carácter en muchas celdas aproximadamente 10000, Ejemplo tengo en una celda 19/09/2009 12:00:00 a.m. Y quisiera poner el carácter al principio de este contenido osea quedando así '19/09/2009 12:00:00 a.m., como lo...
2 respuestas