Te anexo la macro:
Sub GenerarBoletas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Boleta FRM")
ruta = l1.Path & "\" 'para guardar los pdf
'
For Each h In Sheets
Select Case Left(h.Name, 1)
Case "1", "2", "3" 'solamente para las hojas que empiezan con 1, 2 o 3
i = 10
grado = h.[G6]
secc = h.[L6]
Do While h.Cells(i, "A") <> ""
h1.Copy after:=Sheets(Sheets.Count)
Set h2 = ActiveSheet
'datos de los 2 alumnos (2 por hoja)
alum1 = h.Cells(i, "B"): alum2 = h.Cells(i + 1, "B")
clav1 = h.Cells(i, "A"): clav2 = h.Cells(i + 1, "A")
h2.[C3] = clav1: h2.[C28] = clav2
h2.[C6] = alum1: h2.[C31] = alum2
h2.[G4] = grado: h2.[G5] = secc
h2.[G29] = grado: h2.[G30] = secc
Application.StatusBar = "Generando Boletas, Grupo: " & h.Name & ". Alumnos: " & clav1 & "_" & clav2
'
Set r = h.Columns("B")
Set b = r.Find(alum1, lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
bimes = 3
Do
'
fila1 = 9 'fila boleta 1
fila2 = 34 'fila boleta 2
For j = 3 To Columns("Q").Column 'poner calificaciones
h2.Cells(fila1, bimes) = h.Cells(b.Row, j)
h2.Cells(fila2, bimes) = h.Cells(b.Row + 1, j)
fila1 = fila1 + 1
fila2 = fila2 + 1
Next
bimes = bimes + 1 'cambia la columna al sig bimestre
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
h2.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="grupo " & h.Name & " " & clav1 & "_" & clav2 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
h2.Delete
i = i + 2
Loop
End Select
Next
Application.ScreenUpdating = True
MsgBox "fin"
End Sub
Al final de mi respuesta puedes valorar con “Votar” o con “Excelente”, si requieres de más información puedes solicitarla, de lo contrario, podrías cambiar la valoración.