Copiar celdas especificas de un excel a otro con Macros

Tengo un dilema y no se como resolverlo, tengo un archivo que se descarga de una página con un formato que no me funciona, puesto que son demasiados registros para estar validando de uno por uno, lo que quiero es obtener diertos datos de ese excel y colocarlos en otro excel con un formato tipo tabla, les adjunto las imágenes.

Podrían apoyarme por favor!

Este formato eslo que busco y la segunda imagen es uno de los registros de que se descarga...

1 respuesta

Respuesta
1

No distingo bien que datos es los que usas... ¿el numero de vendedor que es el primer dato y los demás donde están? No veo el nombre de la empresa, ¿ni MRPC ni material ni nada xD je je podrás mostrarme en que parte están o decirme en que rango es que aparecen en esa planilla y creamos una macro que copie todo a otra hoja y cree una tabla te parece?

Hola Sebas Torres muchas gracias por responder!

Mira te explico en las columnas de Vendor y Vendor Name siempre serán valores fijos, porque tendrá siempre el mismo numero y nombre de empresa.

Ahora los datos que me interesan más sacar del segundo excel que es la segunda imagen son PART NUMBER Y PART DESCRIPCIÓN, esos datos en la primera imagen osea en la tabla están en las columnas de Material y Material Description

Parte Number = Material

Part description = Material description

Y es que el detalle esta que en la segunda imagen son muchos registros osea muchos números de parte y no están siempre en una celda especifica, tengo que buscar el Part Number junto con su Part description y poder copiarlos en el primer archivo... ¿Me explique?

Prueba este codigo

Sub CreaHojaBuscaDatos()
'AGREGA HOJA Y LE ASIGNA DE NOMBRE "DETALLES - <FECHA HOY>"     <<< ESTO SE PUEDE OBVIAR Y USAR UNA HOJA FIJA
Sheets.Add AFTER:=Sheets(Sheets.Count)
ActiveSheet.Name = "DETALLES - DIA <" & Replace(Date, "/", "-") & ">"
With Cells
    .ColumnWidth = 22
    .RowHeight = 21
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With
With Rows("1:1")
    .Interior.ThemeColor = xlThemeColorLight1
    .Font.ThemeColor = xlThemeColorDark1
    .Font.Size = 14
    .Font.Bold = True
    Range("A1") = "VENDOR NO."
    Range("E1") = "PART NUMBER"
    Range("F1") = "PART DESCRIPTION"
End With
' HASTA ACA LLEGA LA CONFIGURACION DE LA HOJA NUEVA
uFila = Range("A" & Rows.Count).End(xlUp).Row + 1
For Fila = 1 To 10
    If Sheets("Hoja2").Cells(Fila, 1) = "VENDOR NO." Then
        Cells(uFila, 1) = Sheets("HOJA2").Cells(Fila, 1).Offset(1, 0)
    End If
    If Sheets("Hoja2").Cells(Fila, 1) = "PART NUMBER" Then
        Cells(uFila, 5) = Sheets("HOJA2").Cells(Fila, 1).Offset(1, 0)
    End If
    If Sheets("Hoja2").Cells(Fila, 2) = "PART DESCRIPTION" Then
        Cells(uFila, 6) = Sheets("HOJA2").Cells(Fila, 2).Offset(1, 0)
    End If
Next Fila
End Sub

Que tal! Sebas Torres

Ya revise el código y la primera parte si la entiendo, solo que no me queda muy claro lo de la segunda parte.

En esta imagen esta el formato en que se baja de la página, son muchos números de parte pero solo te muestro uno para ver como están acomodados los datos, de este archivo excel deseo sacar el PART NUMBER (W10635596) Y PART DESCRIPTION (DESCRIPCIÓN DEL PRODUCTO) estos datos están ordenados aleatoriamente y nunca se sabe exactamente en que numero de celda esta, entonces quiero sacar estos datos y agregarlos a un excel ya existente que seria el de la imagen uno...

No se si me explique lo que pretendo, trate de adjuntar los archivos pero no pude..

Sebas Torres Hola nuevamente, ya entendí más el código, mi duda es que solo me agrega un registro osea solo un PART NUMBER y se debería de agregar todos los que recorra

Me apoyas nuevamente por fas!

Sebas Torres Olvida los dos comentarios anteriores ja ja, ya logre que se inserten todos, pero hay un detalle se van reemplazando los valores y al final solo queda un registro.

Le agregue un Do Lopp, pero al final se traba la macros

Do Until IsEmpty(ActiveCell)
For Fila = 1 To 10
    If Sheets("Hoja2").Cells(Fila, 1) = "VENDOR NO." Then
        Cells(uFila, 1) = Sheets("HOJA2").Cells(Fila, 1).Offset(1, 0)
    End If
    If Sheets("Hoja2").Cells(Fila, 1) = "PART NUMBER" Then
        Cells(uFila, 5) = Sheets("HOJA2").Cells(Fila, 1).Offset(1, 0)
    End If
    If Sheets("Hoja2").Cells(Fila, 2) = "PART DESCRIPTION" Then
        Cells(uFila, 6) = Sheets("HOJA2").Cells(Fila, 2).Offset(1, 0)
    End If
Next Fila
Lopp

Mueble el ufila para adentro del for para que busque la última fila cada ves que inicie el bucle

Yo le asigne al for que recorra de la fila 1 a la 10 pero ahí puedes cambiarlo, yo puse 10 porque en tu imagen vi que los 3 datos están en las 1O primeras filas

Sebas Torres si ya modifique es alinea y ya quedo =) muchas gracias

Te molesto con mas dudas?? 

Del mismo archivo que bajo de la pagina, en el encabezado esta esta parte, lo que quiero es tomar el valor de Ship To:  el valor a tomar seria INDUSTRIAS

Modificando un poco el codigo tambien quiero tomar el valor de Past Due, seria la fecha que viene debajo, cada renglon es una semana, y quiero que la semana se acomode en el encabezado (lunes . martes, miercoles. jueves, viernes, sabado y domingo) pero de cada semana, me explico??

Asi es como llevo mi codigo modificado hasta ahora

'AGREGA HOJA Y LE ASIGNA DE NOMBRE "TABLA - <FECHA HOY>"     <<< ESTO SE PUEDE OBVIAR Y USAR UNA HOJA FIJA
        Sheets.Add AFTER:=Sheets(Sheets.Count)
        ActiveSheet.Name = "TABLA - DIA <" & Replace(Date, "/", "-") & ">"
        'Ajusta el tamaño de las celdas
        With Cells
            .ColumnWidth = 28
            .RowHeight = 21
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        With Rows("1:1")
            .Interior.ThemeColor = xlThemeColorLight1
            .Font.ThemeColor = xlThemeColorDark1
            .Font.Size = 14
            .Font.Bold = True
            Range("A1") = "Vendor No."
            Range("B1") = "Vendor Name"
            Range("C1") = "Ship To"
            Range("D1") = "Material"
            Range("E1") = "Material Description"
            Range("F1") = "Release Date"
            Range("G1") = "Weekly Quantities"
            Range("H1") = "Past Due"
           ' Range("I1") = "Tuesday"
           ' Range("J1") = "Wednesday"
           ' Range("K1") = "Thursday"
           ' Range("L1") = "Friday"
           ' Range("M1") = "Saturday"
           ' Range("N1") = "Sunday"
        End With
        ' HASTA ACA LLEGA LA CONFIGURACION DE LA HOJA NUEVA
       ult = Sheets("Hoja1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
       For Fila = 1 To ult
        uFila = Range("A" & Rows.Count).End(xlUp).Row + 1
            If Sheets("Hoja1").Cells(Fila, 1) = "VENDOR NO." Then
                Cells(uFila, 1) = Sheets("Hoja1").Cells(Fila, 1).Offset(1, 0)
            End If
            If Sheets("Hoja1").Cells(Fila, 1) = "POLIESTIRENO" Then
                Cells(uFila, 2) = Sheets("Hoja1").Cells(Fila, 1).Offset(1, 0)
            End If
            If Sheets("Hoja1").Cells(Fila, 1) = "Ship To:" Then
                Cells(uFila, 3) = Sheets("Hoja1").Cells(Fila, 1).Offset(1, 0)
            End If
            If Sheets("Hoja1").Cells(Fila, 1) = "PART NUMBER" Then
                Cells(uFila, 4) = Sheets("Hoja1").Cells(Fila, 1).Offset(1, 0)
            End If
            If Sheets("Hoja1").Cells(Fila, 2) = "PART DESCRIPTION" Then
                Cells(uFila, 5) = Sheets("Hoja1").Cells(Fila, 2).Offset(1, 0)
            End If
            If Sheets("Hoja1").Cells(Fila, 4) = "RELEASE DATE" Then
                Cells(uFila, 6) = Sheets("Hoja1").Cells(Fila, 4).Offset(1, 0)
            End If
            If Sheets("Hoja1").Cells(Fila, 2) = "QUANTITIES" Then
                Cells(uFila, 7) = Sheets("Hoja1").Cells(Fila, 2).Offset(1, 0)
            End If
            If Sheets("Hoja1").Cells(Fila, 1) = "Past Due" Then
                Cells(uFila, 8) = Sheets("Hoja1").Cells(Fila, 1).Offset(1, 0)
                Cells.Value = CStr(Cells)
            End If
       Next Fila

El tema es que hay mucho de esos datos que no los encuentro o no están por el nombre que tu me dices ...

Tendrías que pasarme una lista de en que columna esta cada campo y donde aparece el dato

Ejemplo:

- Vendor No. Esta en Columna1, El dato esta en misma columna, siguiente fila

- Ship To esta en Columna1, El dato esta en Columna 2, misma fila

- Weekly Quantities esta en la Columna2, El dato esta en misma columna, siguiente fila

De esta forma yo se donde poner cada referencia y de donde sacar cada dato,¿no se si me explique bien?

Si claro que te explicaste y creo que ese punto ya quedo solucionado, lo hice de la siguiente manera:

If Sheets("Hoja1").Cells(Fila, 1) = "Ship To:" Then
   Cells(uFila, 3) = Sheets("Hoja1").Cells(Fila, 1).Offset(0, 1)
End If
            

Crees que se pueda empezar la lectura del archivo dos del que bajo de la página, ¿a partir de la línea 14?

Excelente! De a poco agarras la mano a VBA =P je je...

Seguro la línea que controla desde donde empieza hasta donde va es esta

For Fila = 1 To ult

Como ves, empieza desde la Fila 1 hasta la ultima fila con datos

Solo cambia el "1" por "14"

En cuanto a los Offset vas bien! Excelente observación je je

Cuando es "Offset(-1,0)" te mueves 1 fila hacia arriba

Cuando es "Offset(1,0)" te mueves 1 fila hacia abajo

Cuando es "Offset(0,-1)" te mueves 1 columna hacia la izquierda

( Si lo usas sobre a te da error, ya que no hay otra columna antes que A)

Cuando es "Offset(0,1)" te mueves 1 columna hacia la derecha

Sebas Torres si poco a poco y gracias a tu ayuda!

Tengo una cuestión en donde me acomoda los datos con una celda de desfacé, si te fijas la primer columna de Material, Material Description y Weekly esta en blanco, pero no entiendo porque razón

Prueba usar la función "LCASE" para pasar todo a minúscula quizás tengas algún error por coincidencias..

Por ejemplo las líneas son así

 If Sheets("Hoja1").Cells(Fila, 1) = "VENDOR NO." Then

Escribelas asi

 If LCASE(Sheets("Hoja1").Cells(Fila, 1)) = LCASE("VENDOR NO.") Then

y prueba hacer si eso te soluciona, de lo contrario enviame una copia si quieres asi no creo una a cada rato xD jeje... mi correo es:   [email protected]

Ya lo probé y sigue sin funcionar, te mande correo

Gracias!

Te envíe un mail con tu archivo editado..

Se te estaban reemplazando los datos porque siempre escribía sobre la ultima fila de la columna A je je pero bue... recuerda que solo estas copiando algunos datos, todo el detalle de las fechas de cada día no se esta creando.. eso vas a tener que crear algún tipo de bucle (cosa que yo no se hacer xD ) je je porque se hace con Do Loop While me parece y yo falte ese día xD ja ja no se como se usa esa función nunca aprendí ... cuak! Je je

Lo que puedes hacer es que elimine la hoja y la cree nuevamente de la siguiente forma

Cambiando estas líneas

Sheets.Add AFTER:=Sheets(Sheets.Count)
        ActiveSheet.Name = "TABLA - DIA <" & Replace(Date, "/", "-") & ">"

por esto

i = "TABLA - DIA <" & Replace(Date, "/", "-") & ">"
On Error Resume Next
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add AFTER:=Sheets(Sheets.Count)
        ActiveSheet.Name = i

Asi si la hoja existe la elimina y crea otra y luego sigue el resto del codigo de formato y copiado...

Error de filas vacias solucionado =)

arriba de

xFil7 = fila7 + 10
GoTo Inicio

Agregale " Rows(uFila).Delete " esto hara que elimine la copia que hizo ya que no la va a utilizar

quedaria asi

Rows(ufila).Delete
xFil7 = fila7 + 10
GoTo Inicio

esto se debe a que cada semana de datos que agrega, al finalizar copia todo el encabezado para seguir con la misma referencia, pero al no encontrar mas datos pasa a la siguiente fila en busca de los nuevos datos de otro encabezado , quedando esa copia vacia o sin datos en la semana(ya que no existen)

Agregando esa línea borrara esas filas innecesarias

Ahora te esta creando 3257 filas de datos contando esas filas, te tendría que dar 3076 filas

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas