Te anexo la macro
Sub reporte1()
'
'***Por Dante Amor
'
Application.ScreenUpdating = False
Set h1 = Sheets("RegCertificado") 'origen
Set h2 = Sheets("Plantilla") 'destino
'
h2.Rows("2:" & Rows.Count).ClearContents
'
dni = h2.Range("B1")
If dni = "" Then
MsgBox "Captura DNI"
Exit Sub
End If
'
u = h1.Range("D" & Rows.Count).End(xlUp).Row
With h1.Sort
.SortFields.Clear
.SortFields.Add Key:=h1.Range("D3:D" & u)
.SortFields.Add Key:=h1.Range("G3:G" & u)
.SetRange h1.Range("A2:L" & u): .Header = xlYes
.MatchCase = False: .Orientation = xlTopToBottom
.SortMethod = xlPinYin: .Apply
End With
'
Set r = h1.Columns("D")
Set b = r.Find(dni, lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
h2.Cells(3, "C") = h1.Cells(b.Row, "C")
h2.Cells(5, "C") = h1.Cells(b.Row, "G")
j = 6
Do
If ant <> h1.Cells(b.Row, "H") Then
h2.Cells(j + 1, "A") = "SEMESTRE " & h1.Cells(b.Row, "H")
j = j + 2
End If
'
h2.Range("A" & j) = h1.Cells(b.Row, "J")
h2.Range("B" & j) = h1.Cells(b.Row, "K")
h2.Range("C" & j) = h1.Cells(b.Row, "L")
h2.Range("D" & j) = h1.Cells(b.Row, "K") * h1.Cells(b.Row, "L")
j = j + 1
ant = h1.Cells(b.Row, "H")
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
Else
MsgBox "DNI no existe", vbExclamation
End If
End Sub
.
'S aludos.