Código Macro para fijar títulos
Si yo tengo 5 hojas de un libro excel con información de los trabajadores, en cada hoja se repiten los títulos, por ejemplo, nombre, rut, edad, etc.. Y quiero traspasar estos datos a un hoja que concentre toda la información, ¿existe algún código macros para que mantenga los títulos y no los repita igual que los demás datos?
1 Respuesta
Si está en el mismo rango ("A1:W1") pero tengo la siguiente macro en el modulo 1, ¿dónde debería ingresar este código?
Range("A1:W" & ufh).Copy . en esta parte Si coloco A1 se repiten entre medio de los datos los títulos, por esto esta desde A2. En la macro que adjunto,
Sub unionhojas()
Sheets("Union").Select 'Recuerda nombrar una hoja con el nombre de Union
Cells.ClearContents
ultimf = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
For hoja = 50 To 61
Sheets(hoja).Select
ufh = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A2:W" & ufh).Copy 'en esta linea puedes modificar el rango de celdas a copiar
Sheets("Union").Select
ultimf = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A" & ultimf).PasteSpecial Paste:= xlPasteValues
Next hoja
MsgBox ("Fin preceso informacion unida")
End Sub
Pues si gustas al final una vez que haya terminado el proceso de copiado después de tu Nex Hoja puedes poner sheets("Union").range("A1:W1")=sheets("VENTAS"). Range("A1:W1")
Para ejemplificar te puse el nombre de ventas tu adáptalo como se llame tu hoja 50
¿Se resolvió tu problema´? O si gustas mándame tu archivo para trabajarlo y te lo reenvío.
sub unionhojas()
Sheets("Union").Select 'Recuerda nombrar una hoja con el nombre de Union
Cells.ClearContents
TitOrigen = "A1:w1" 'Rango donde están los títulos
Sheets("Hoja 2").Range(TitOrigen).Copy
Sheets("union").Range("A1").PasteSpecial Paste:=xlPasteValues
ultimf = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
For hoja = 50 To 61
Sheets(hoja).Select
ufh = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A2:W" & ufh).Copy 'en esta linea puedes modificar el rango de celdas a copiar
Sheets("Union").Select
ultimf = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A" & ultimf).PasteSpecial Paste:= xlPasteValues
Next hoja
MsgBox ("Fin preceso informacion unida")
End Suben esta parte Sheets("Hoja 2").Range(TitOrigen).Copy,en lugar de "Hoja 2" ponle el nombre real de la hoja donde se encuentre el título que deseas copiar y debería de quedar
¡Gracias!
Estimado a funcionado perfecto, tengo dos macros y quedaron así:
Con esto se mantiene el titulo y no se repite entre los archivos, muchas gracias de nuevo.
Sub unionhojas()
Sheets("Union").Select 'Recuerda nombrar una hoja con el nombre de Union
Cells.ClearContents
TitOrigen = "A1:w1" 'Rango donde están los títulos
Sheets("ENERO 2017").Range(TitOrigen).Copy 'ENERO 2017
Sheets("UNION").Range("A1").PasteSpecial Paste:= xlPasteAll 'lo cambie a pase all para copiar con todo y formato, UNION.
ultimf = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
For hoja = 50 To 61
Sheets(hoja).Select
ufh = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A2:W" & ufh).Copy 'en esta linea puedes modificar el rango de celdas a copiar
Sheets("Union").Select
ultimf = Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
Range("A" & ultimf).PasteSpecial Paste:= xlPasteAll 'lo cambie a pase all para copiar con todo y formato
Next hoja
MsgBox ("Fin preceso informacion unida")
End Subsegunda macro
Sub unionhojas()
Set h1 = Sheets("Union")
h1.Cells.ClearContents
TitOrigen = "A1:w1" 'Rango donde están los títulos
Sheets("ENERO 2017").Range(TitOrigen).Copy
Sheets("UNION").Range("A1").PasteSpecial Paste:= xlPasteAll 'lo cambie a paste all
For hoja = 51 To 61
Set h2 = Sheets(hoja)
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
u2 = h2.Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
h2.Range("A2:W" & u2).Copy h1.Range("A" & u1)
Next hoja
MsgBox ("Fin preceso informacion unida")
End Sub
