Necesitamos un fichero *.xlxm habilitado para ejecutar macros cuya primera pestaña sea "RMSD", segunda "DeltaG" y tercera "template".Los datos se encuentran desde B3:B2003.

La pestaña "template" tiene los gráficos y configuraciones iniciales que se utilizarán para clonar y personalizar los nuevos gráficos.

Sub ClonarTemplate_VersionFinal_Perfecta()
Dim wb As Workbook
Dim wsRMSD As Worksheet, wsDG As Worksheet, wsTemplate As Worksheet, wsNew As Worksheet
Dim lastCol As Long, lastRowRMSD As Long, lastRowDG As Long
Dim i As Long, j As Long, grupoIdx As Long
Dim colIdx As Long, groupSize As Long
Dim chRMSD As Chart, chDG As Chart
Dim fullColName As String, labelName As String
Dim colLetra As String
Dim fY_RMSD As String, fY_DG As String
' Paleta de colores RGB de la plantilla (Rojo, Amarillo, Verde, Cian, Morado)
Dim colores(1 To 5) As Long
colores(1) = RGB(218, 31, 40) ' Rojo
colores(2) = RGB(244, 190, 16) ' Amarillo / Oro
colores(3) = RGB(35, 161, 88) ' Verde
colores(4) = RGB(0, 178, 238) ' Cian / Azul claro
colores(5) = RGB(112, 48, 160) ' Morado
' Optimización de velocidad en el entorno Excel
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wb = ThisWorkbook
Set wsRMSD = wb.Sheets("RMSD")
Set wsDG = wb.Sheets("DeltaG")
Set wsTemplate = wb.Sheets("template")
' Medición de las dimensiones reales de los datos
lastRowRMSD = wsRMSD.Cells(wsRMSD.Rows.Count, 1).End(xlUp).Row
lastRowDG = wsDG.Cells(wsDG.Rows.Count, 1).End(xlUp).Row
lastCol = wsRMSD.Cells(1, wsRMSD.Columns.Count).End(xlToLeft).Column
groupSize = 5
grupoIdx = 1
' Segmentación en bloques de 5 columnas (comenzando en la columna 2, la columna 1 tiene el tiempo.)
For i = 2 To lastCol Step groupSize
' 1. Clonación exacta de la pestaña molde
wsTemplate.Copy After:=wb.Sheets(wb.Sheets.Count)
Set wsNew = wb.Sheets(wb.Sheets.Count)
wsNew.Name = "Grupo_" & grupoIdx
' Vinculación de los gráficos de la nueva hoja
Set chRMSD = wsNew.ChartObjects(1).Chart
Set chDG = wsNew.ChartObjects(2).Chart
' Eliminación definitiva de títulos superpuestos dentro del gráfico
chRMSD.HasTitle = False
chDG.HasTitle = False
' =============================================================
' 2. PROCESAMIENTO DE DATOS, COLORES Y ESTADÍSTICAS
' =============================================================
For j = 0 To groupSize - 1
colIdx = i + j
If colIdx <= lastCol Then
' Extracción limpia del identificador del compuesto (Molport)
fullColName = wsRMSD.Cells(1, colIdx).Value
If InStr(fullColName, "Molport-") > 0 Then
labelName = Mid(fullColName, InStr(fullColName, "Molport-"))
Else
labelName = fullColName
End If
' Traducir índice numérico a coordenadas de letra de Excel
colLetra = Split(wsRMSD.Cells(1, colIdx).Address, "$")(1)
' Mapeo estricto iniciando en la fila $3
fY_RMSD = "='" & wsRMSD.Name & "'!$" & colLetra & "$3:$" & colLetra & "$" & lastRowRMSD
fY_DG = "='" & wsDG.Name & "'!$" & colLetra & "$3:$" & colLetra & "$" & lastRowDG
' --- AJUSTES GRÁFICO 1: RMSD (Líneas) ---
With chRMSD.SeriesCollection(j + 1)
.Values = fY_RMSD
.Name = labelName
.Format.Line.ForeColor.RGB = colores(j + 1)
End With
' --- AJUSTES GRÁFICO 2: DeltaG (Dispersión de puntos) ---
With chDG.SeriesCollection(j + 1)
.Values = fY_DG
.Name = labelName
.MarkerBackgroundColor = colores(j + 1)
.MarkerForegroundColor = colores(j + 1)
End With
' --- VINCULACIÓN DE TABLA ESTADÍSTICA (Columnas O, P, Q) ---
' Celda O: Nombre dinámico de la fila 2 de la simulación
wsNew.Cells(j + 2, "O").FormulaLocal = "=RMSD!" & colLetra & "$2"
' Celda P: Cálculo de promedio matemático (Fila 3 en adelante)
wsNew.Cells(j + 2, "P").FormulaLocal = _
"=PROMEDIO(DeltaG!" & colLetra & "$3:$" & _
colLetra & "$" & lastRowDG & ")"
' Celda Q: Cálculo de desviación estándar (Fila 3 en adelante)
wsNew.Cells(j + 2, "Q").FormulaLocal = _
"=DESVEST(DeltaG!" & colLetra & "$3:$" & _
colLetra & "$" & lastRowDG & ")"
Else
' Gestión cuando el último bloque cuenta con menos de 5 elementos
If chRMSD.SeriesCollection.Count >= (j + 1) Then chRMSD.SeriesCollection(j + 1).Delete
If chDG.SeriesCollection.Count >= (j + 1) Then chDG.SeriesCollection(j + 1).Delete
' Limpieza física de las celdas sobrantes
wsNew.Cells(j + 2, "O").Value = ""
wsNew.Cells(j + 2, "P").Value = ""
wsNew.Cells(j + 2, "Q").Value = ""
End If
Next j
grupoIdx = grupoIdx + 1
Next i
' Devolución del control operacional a Excel
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "¡Proyecto terminado!" & vbCrLf & _
"- Rangos ajustados desde la fila 3 de forma limpia." & vbCrLf & _
"- Gráficos escalados, sin títulos y con colores iguales." & vbCrLf & _
"- Mapeo estadístico (Mean & SD) sincronizado al 100%.", vbInformation, "Fin del Proceso"
End Sub