Agregar más tareas a una macro, color de texto y nombre de hojas a copiar
Ejecución de la macro: Crea una hoja llamada Global. Copia el contenido de todas las hojas existentes a esa Global
Quisiera que después de ejecutada la macro, o en su ejecución, quedara como se ve en la imagen de la hoja Global. Que es la creada para recibir las copias. Los títulos ya yo pude agregar, y el 1º titulo con el color y negrita, pero no tengo la capacidad para lo demás y Tambien el nombre de cada hoja existente asi como el color del texto que lo hice en el primer, (usando la grabadora) pero me falta que lo haga para todas las copias.
Copiar el nombre de cada hoja y darle el color vbRed a Negrita (Bold) al nombre y titulos
Sub JuntarHojas()
Application.DisplayAlerts = False
For Each hoja In ActiveWorkbook.Sheets
If hoja.Name = "Global" Then hoja.Delete
Next
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Global"
With Range("A1:M1").Font
.Color = vbRed
.Bold = True
End With
For x = 2 To Sheets.Count
Sheets(x).Select
Range("a1:o" & Range("a65000").End(xlUp).Row).Copy
Sheets("Global").Range("a65000").End(xlUp).Offset(0, 0).PasteSpecial Paste:=xlValues
Next
Sheets("Global").Select
Range("A1").Select
End Sub
1 respuesta
Esta la imagen
De como quisiera que quedara.
Disculpa Elsa, falta mía
Gracias por tarde responder, per oes que no recibí notificación de esta y otras preguntas, tanto mías como de otros usuarios al cual estoy inscripto
No te preocupes, nadie recibía las notificaciones ;(
Primero debes darle el formato a las 2 primeras filas, es decir al rango A1:M2
Y luego se copiará ese formato a las 2 primeras filas de cada rango pegado.
La macro te quedaría así:
Sub JuntarHojas()
'ajustada x Elsamatilde
Application.DisplayAlerts = False
For Each hoja In ActiveWorkbook.Sheets
If hoja.Name = "Global" Then hoja.Delete
Next
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Global"
With Range("A1:M2").Font
.Color = vbRed
.Bold = True
End With
'1ra fila destino
y = 1
For x = 2 To Sheets.Count
Sheets(x).Select
Range("a1:o" & Range("a65000").End(xlUp).Row).Copy
With Sheets("Global")
.Range("a" & y).PasteSpecial Paste:=xlValues
.Range("A1:M2").Copy
.Range("A" & y).PasteSpecial Paste:=xlPasteFormats
'guarda la próxima celda libre
y = .Range("a65000").End(xlUp).Row + 1
End With
Next
Sheets("Global").Select
Range("A1").Select
End SubFijate que en tu macro estabas superponiento una fila porque no incrementas en 1 la fila del pegado.
. Range("a65000").End(xlUp).Offset(0, 0).PasteSpecial Paste:=xlValues
Gracia sElsa por tu ayuda,
Te diré que la primera y 2ª línea salen en rojo, pero en la 2ª de cada debería en ves de datos, el nombre de la hoja correspondente.
Las 2ªs líneas rojas dicen: Datos1 (Dtos2, Datos3 etc, deberían en DE (quizá) mencionar solo el nombre de la hoja correspondente.
Gracias Elsa
Las 2ªs líneas rojas dicen: Datos1 (Datos2, Datos3 etc, deberían en DE (quizá) mencionar solo el nombre de la hoja correspondente. En esa 2ªs líneas roja de cada inicio de Hoja
¿En col D primera línea dice Depto1... allí necesitas que diga el nombre de la hoja?
Las 2ªs líneas rojas dicen: Datos1... no, no se ve así en segunda línea, aclara x favor.
Sdos!
Correcto:
¿En col DE primera línea dice Depto1... allí necesitas que diga el nombre de la hoja? Si, el nombre de la Hoja; Depto 1, Depto 2, etc o según el nombre que tenga cada hoja
Las 2ªs líneas rojas dicen: Datos1... no, no se ve así en segunda línea, aclara por favor.
En la Hoja Global debe verse
1ªs líneas rojas = Nombre de la hoja desde la cual proceden los datos
2ªs líneas rojas = Títulos de cada hoja desde la cual proceden los datos
Gracias Elsa y buen día para ti
Etc. etc.
Así se verá y así quedó la macro.
Sub JuntarHojas()
'ajustada x Elsamatilde
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each hoja In ActiveWorkbook.Sheets
If hoja.Name = "Global" Then hoja.Delete
Next
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Global"
With Range("A1:M2").Font
.Color = vbRed
.Bold = True
End With
'1ra fila destino
y = 1
For x = 2 To Sheets.Count
Sheets(x).Select
Range("a1:o" & Range("a65000").End(xlUp).Row).Copy
With Sheets("Global")
.Range("D" & y) = Sheets(x).Name '1ER FILA
.Range("a" & y + 1).PasteSpecial Paste:=xlValues 'CONTENIDO A PARTIR DE LA 2DA FILA
.Range("A1:M2").Copy 'FORMATO APLICADO AL RANGO A1:M2
.Range("A" & y).PasteSpecial Paste:=xlPasteFormats
'guarda la próxima celda libre
y = .Range("a65000").End(xlUp).Row + 1
End With
Next
Sheets("Global").Select
Application.CutCopyMode = False
Range("A1").Select
End SubVa el código explicado para que puedas realizar algún otro ajuste.
Sdos!
¡Gracias! Elsa, tenias que ser tú.
Son poc@s los que comparten con amabilidad y generosidad sus conocimientos, siempre no mal hablando de los demas con conocimientos menos atrevidos pero que tambien se reconoce su afan de ayudar, y eso hay que reconocerles su esfuerzo.
Gracias Elsa
