Código para filtrar por concepto:
h2.Columns("C:C").Copy h3.[A1]
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row
h3.Range("A1:A" & u3).RemoveDuplicates Columns:=1, Header:=xlYes
For i = 2 To h3.Range("A" & Rows.Count).End(xlUp).Row
j = 2
Set r = h2.Columns("C")
Set b = r.Find(h3.Cells(i, "A"), lookat:=xlWhole)
If Not b Is Nothing Then
celdai = b.Address
nombre = h2.Cells(b.Row, "C")
carpet = h2.Cells(b.Row, "D") & "\"
subcar = h2.Cells(b.Row, "E") & "\"
paraev = h2.Cells(b.Row, "F")
concop = h2.Cells(b.Row, "F")
asunto = h2.Cells(b.Row, "G")
cuerpo = h2.Cells(b.Row, "H")
Do
'detalle
h3.Cells(i, j) = b.Offset(0, -1)
j = j + 1
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celdai
arreglo = Array(h3.Range(h3.Cells(i, 2), h3.Cells(i, j - 1)))
End If
'
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("A1:H" & u1).AutoFilter Field:=5, Criteria1:=Array(arreglo), _
Operator:=xlFilterValues
'
u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
h1.Range("A1:H" & u1).Copy h4.[A1]
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias