Jump to content

Txito

Members
  • Content Count

    38
  • Joined

  • Last visited

About Txito

  • Rank
    Member
  • Birthday 02/19/1973
  1. Una última cosa: he editado la macro para introducir una tercera fila, y he reparado el error que había encontrado -una de mis pestañas no estaba bien nombrada-. De todas maneras creo que la edición está bien hecha pero compruébalo por si acaso. Muchísimas gracias. Sub ColocarMuñecos() Dim Columna, Hoja, Fila, AnchoColumna, x Application.ScreenUpdating = False Fila = 2 'Fila inicio muñecos Columna = 2 AnchoColumna = 1.5 'Ancho de columna AltoFila = 15 'Alto de fila 'Borramos las filas donde van los muñecos For x = Fila To Fila + 24: Sheets("Uniformes").Rows(x).Clear: Next x 'Fijamos ancho de columna Sheets("Uniformes").Columns.ColumnWidth = AnchoColumna Sheets("Uniformes").Rows.RowHeight = AltoFila 'Bucle de hojas For Each Hoja In Sheets 'Seleccionamos solo las hojas con muñeco If Hoja.Name <> "Uniformes" And _ Hoja.Name <> "Fijos" And _ Hoja.Name <> "Fichajes" Then 'Mofificamos la fila de inicio y controlamos fin If Hoja.Name = "2ª" Then Fila = Fila + 14 Columna = 2 ElseIf Hoja.Name = "3ª" Then Fila = Fila + 14 Columna = 2 ElseIf Hoja.Name = "Equipos" Then Exit Sub ElseIf Hoja.Name <> "1ª" Then 'Copiamos el muñeco Hoja.Range("N7:S19").Copy _ Sheets("Uniformes").Range(Cells(Fila, Columna), Cells(Fila + 12, Columna + 6)) 'Ponemos borde al muñeco Sheets("Uniformes").Range(Cells(Fila, Columna), Cells(Fila + 12, Columna + 5)) _ .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 'Nos desplazamos al muñeco siguiente Columna = Columna + 7 End If End If Next End Sub
  2. Perdona Antoni, creo que tenía un problema con los tokens de seguridad del foro y no vi tu respuesta PERFECTA. Muchas gracias por todo.
  3. Hola Antoni He probado el último código y conseguimos copiar las hojas entre 1ª y 2ª en ambas filas y -a lo mejor no me he explicado yo bien- quiero pegar en la primera fila los muñecos de las hojas entre 1ª y 2ª y en la segunda fila los muñecos de las hojas entre 2ª y 3ª Saludos
  4. Hola Antoni He probado el último código y conseguimos copiar las hojas entre 1ª y 2ª en ambas filas y -a lo mejor no me he explicado yo bien- quiero pegar en la primera fila los muñecos de las hojas entre 1ª y 2ª y en la segunda fila los muñecos de las hojas entre 2ª y 3ª Saludos
  5. Pruebo primero la tuya, que no había visto la respuesta... Otra posible solución que no me funciona: 'Seleccionamos solo las hojas entre las hojas 1ª y 2ª For Each sht In Sheets If sht.Name = "1ª" Then 'Copiamos el muñeco Hoja.Range("N7:S19").Copy _ Sheets("Uniformes").Range(Cells(Fila2, Columna2), Cells(Fila2 + 12, Columna2 + 6)) 'Ponemos borde al muñeco Sheets("Uniformes").Range(Cells(Fila2, Columna2), Cells(Fila2 + 12, Columna2 + 5)) _ .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 'Nos desplazamos al muñeco siguiente Columna2 = Columna2 + 7 Else If sht.Name = "2ª" Then Exit For End If End If Next sht
  6. He introducido un par de líneas de código intentando definir de qué hojas tomar los datos, pero el resultado no ha sido el esperado, sino que copia los datos de todas las hojas: Sub CopiarMuñecos() Dim Columna, Hoja, Fila, AnchoColumna, x Application.ScreenUpdating = False Fila = 2 'Fila inicio muñecos Fila2 = 16 '2ª Fila inicio muñecos Fila0 = 1 Columna = 2 'Columna inicio muñecos Columna2 = 2 '2ª Columna inicio muñecos Columna0 = 2 AnchoColumna = 2 'Ancho de columna AltoFila = 15 'Alto de fila 'Borramos las filas donde van los muñecos For x = Fila To Fila + 12: Sheets("Uniformes").Rows(x).Clear: Next x For y = Fila2 To Fila2 + 12: Sheets("Uniformes").Rows(y).Clear: Next y 'Fijamos ancho de columna Sheets("Uniformes").Columns.ColumnWidth = AnchoColumna Sheets("Uniformes").Rows.RowHeight = AltoFila 'Bucle de hojas For Each Hoja In Sheets 'Seleccionamos solo las hojas con muñeco If Hoja.Name <> "Uniformes" And _ Hoja.Name <> "1ª" And _ Hoja.Name <> "2ª" And _ Hoja.Name <> "3ª" Then 'Copiamos el muñeco Hoja.Range("N7:S19").Copy _ Sheets("Uniformes").Range(Cells(Fila, Columna), Cells(Fila + 12, Columna + 6)) 'Ponemos borde al muñeco Sheets("Uniformes").Range(Cells(Fila, Columna), Cells(Fila + 12, Columna + 5)) _ .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 'Nos desplazamos al muñeco siguiente Columna = Columna + 7 End If 'Seleccionamos solo las hojas entre las hojas 1ª y 2ª Dim i As Integer With ThisWorkbook For i = .Sheets("1ª").Index + 1 To .Sheets("2ª").Index - 1 Next End With 'Copiamos el muñeco Hoja.Range("N7:S19").Copy _ Sheets("Uniformes").Range(Cells(Fila2, Columna2), Cells(Fila2 + 12, Columna2 + 6)) 'Ponemos borde al muñeco Sheets("Uniformes").Range(Cells(Fila2, Columna2), Cells(Fila2 + 12, Columna2 + 5)) _ .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 'Nos desplazamos al muñeco siguiente Columna2 = Columna2 + 7 Next End Sub
  7. Hola de nuevo Antoni. Muchas gracias por tu respuesta. No solo hace el trabajo a la perfección, sino que la macro es sencilla y entendible para profanos como yo. He modificado la macro pensando en copiar en varias filas y ha sido un éxito: Sub CopiarMuñecos() Dim Columna, Hoja, Fila, AnchoColumna, x Application.ScreenUpdating = False Fila = 2 'Fila inicio muñecos Fila2 = 16 '2ª Fila inicio muñecos Fila0 = 1 Columna = 2 'Columna inicio muñecos Columna2 = 2 '2ª Columna inicio muñecos Columna0 = 2 AnchoColumna = 2 'Ancho de columna AltoFila = 15 'Alto de fila 'Borramos las filas donde van los muñecos For x = Fila To Fila + 12: Sheets("Uniformes").Rows(x).Clear: Next x For y = Fila2 To Fila2 + 12: Sheets("Uniformes").Rows(y).Clear: Next y 'Fijamos ancho de columna Sheets("Uniformes").Columns.ColumnWidth = AnchoColumna Sheets("Uniformes").Rows.RowHeight = AltoFila 'Bucle de hojas For Each Hoja In Sheets 'Seleccionamos solo las hojas con muñeco If Hoja.Name <> "Uniformes" And _ Hoja.Name <> "1ª" And _ Hoja.Name <> "2ª" And _ Hoja.Name <> "3ª" Then 'Copiamos el muñeco Hoja.Range("N7:S19").Copy _ Sheets("Uniformes").Range(Cells(Fila, Columna), Cells(Fila + 12, Columna + 6)) 'Ponemos borde al muñeco Sheets("Uniformes").Range(Cells(Fila, Columna), Cells(Fila + 12, Columna + 5)) _ .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 'Nos desplazamos al muñeco siguiente Columna = Columna + 7 End If 'Seleccionamos solo las hojas con muñeco If Hoja.Name <> "Uniformes" And _ Hoja.Name <> "1ª" And _ Hoja.Name <> "2ª" And _ Hoja.Name <> "3ª" Then 'Copiamos el muñeco Hoja.Range("N7:S19").Copy _ Sheets("Uniformes").Range(Cells(Fila2, Columna2), Cells(Fila2 + 12, Columna2 + 6)) 'Ponemos borde al muñeco Sheets("Uniformes").Range(Cells(Fila2, Columna2), Cells(Fila2 + 12, Columna2 + 5)) _ .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium 'Nos desplazamos al muñeco siguiente Columna2 = Columna2 + 7 End If Next End Sub El siguiente reto es pedirle que copie sólamente las hojas que se encuentran entre las hojas llamadas 1ª y 2ª sin tener que escribir todos sus nombres (el libro sobre el que trabajo tiene un número de hojas bastante grandes). Muchas gracias de nuevo.
  8. Hola Antoni Gracias por interesarte. He probado el código, cambiando el +12 por +13, para que coincida el tamaño de rangos, y el depurador emite un error 1004 en el método PasteSpecial. Para ser más claro acerca de lo que pretendo, quiero copiar las celdas con los muñecos de todas las pestañas a una sola hoja (en principio) del libro.
  9. Hola Os muestro el código que intento hacer valer en un fichero, de modo que la macro me haga una copia del rango n7:s19 de todas las hojas del libro, conservando formatos (bordes, relleno de celdas y ancho de columnas). He probado varias maneras y en todas ellas me da error: Sub Format() Dim ws As Worksheet With Application .ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets With ws .Range("n7:s19").Copy .Range("A" & Cells.Rows.Count).PasteSpecial xlPasteFormats End With Next ws .CutCopyMode = False .ScreenUpdating = True End With ActiveWorkbook.Save End Sub Uniformex.zip
  10. Sub Copia() Dim MyLbr As String MyLbr = Application.GetOpenFilename(, , "Seleccione el libro a procesar", , False) If MyLbr = CStr(False) Then Exit Sub Workbooks.Open Filename:=MyLbr With ActiveWorkbook.Sheets("Bracamonte") Range("n7:s19").Copy _ ThisWorkbook.Sheets("Base").Range("a" & Rows.Count).End(xlUp).Offset(1) End With ActiveWorkbook.Close False End Sub Con esto sólamente consigo copiar de una hoja y no copia el ancho de las columnas
  11. No sé si será posible hacer lo que quiero, porque lo veo un poco raro Se trata de copiar unas celdas determinadas de varias hojas. Hasta aquí bien. Lo que no sé si se puede es que esta copia dependa de la posición de la hoja en el libro. Pero mejor que explicarlo es ver el ejemplo. Un saludo y gracias de antemano por ayudar Uniformex.zip
  12. Niquelado. Justamente el resultado esperado. Muchísimas gracias.
  13. Subido el archivo. El nombre del archivo es orientativo... jajajaja Floritura.zip
  14. Ahora mismo la pruebo y os cuento. De todas formas, gracias a los tres por la rapidez. Probada con éxito tremendo... la de trabajo que me acabáis de ahorrar... mil gracias Otra vuelta de tornillo, ya sería la caña... la celda a mostrar en este caso correspondía a la columna C, si yo tuviera varias columnas con datos (C, D, E, F y G), ¿podría mostrarse el dato de estas columnas en función de una celda? Es decir, si yo tuviera una celda que yo editara (J1) y que tomara valores de 3 a 7, ¿podría corresponderse 3 con C, 4 con D, 5 con E, etc.? Desconozco si se pueden combinar una fórmula condicional y una fórmula matricial.
  15. Hola a todos. Después de leer varios post y examinar varios archivos, creo que esta búsqueda no se ajusta a ninguna de las planteadas anteriormente (o eso, o no me he enterado con alguna función). Dispongo de dos columnas de datos en las que pueden hallarse datos repetidos en cada columna, pero nunca los datos de cada fila estarán repetidos. Necesito encontrar la fila cuyos valores de las dos primeras celdas coincidan con los datos solicitados y que esa búsqueda me arroje el valor de una tercera columna Os adjunto un ejemplo simplificado. yo lo he intentado condicionando la igualdad de celdas en la búsqueda, pero al haber valores duplicados la fórmula de búsqueda falla. Muchas gracias de antemano Buscar.zip
×
×
  • Create New...

Important Information

Privacy Policy