Máximos colaboradores

Parece que este tema se ha resuelto ya en la sección de macros Agrupar datos y valores de una hoja a otra en resumen

Sub BuscarCoincidencias() Dim hoja1 As Worksheet Dim hoja2 As Worksheet Dim rango As Range Dim celda As Range Dim buscado As Variant Dim contador As Integer Dim suma As Double Dim celdaBuscar As Range Dim ultimaFila As Long Dim valoresBuscados() As Variant Dim encontrado As Boolean Set hoja1 = ThisWorkbook.Sheets("Hoja1") Set hoja2 = ThisWorkbook.Sheets("Hoja2") Set celdaBuscar = hoja1.Range("A3") ultimaFila = hoja1.Cells(hoja1.Rows.Count, celdaBuscar.Column).End(xlUp).Row ReDim valoresBuscados(0 To 0) For i = celdaBuscar.Row To ultimaFila buscado = hoja1.Cells(i, celdaBuscar.Column).Value encontrado = False For Each valor In valoresBuscados If valor = buscado Then encontrado = True Exit For End If Next valor If encontrado Then GoTo SiguienteValor contador = 0 suma = 0 For j = i To ultimaFila If hoja1.Cells(j, celdaBuscar.Column).Value = buscado Then contador = contador + 1 suma = suma + hoja1.Cells(j, celdaBuscar.Column + 9).Value End If Next j If contador >= 5 Then Set rango = hoja2.Columns("C:C").Find(What:=buscado, LookAt:=xlWhole) If Not rango Is Nothing Then If buscado >= 400 Then hoja2.Cells(rango.Row, "F").Value = suma Else hoja2.Cells(rango.Row, "E").Value = suma End If End If Else Set rango = hoja2.Columns("C:C").Find(What:=buscado, LookAt:=xlWhole) If Not rango Is Nothing Then If buscado >= 400 Then hoja2.Cells(rango.Row, "F").Value = suma Else hoja2.Cells(rango.Row, "E").Value = suma End If End If End If valoresBuscados(UBound(valoresBuscados)) = buscado ReDim Preserve valoresBuscados(0 To UBound(valoresBuscados) + 1) SiguienteValor: Next i hoja2.Range("E5").Value = hoja2.Cells(7, "E").Value - (hoja2.Cells(2, "E").Value + hoja2.Cells(3, "E").Value + hoja2.Cells(4, "E").Value) hoja2.Range("E29").Value = Application.WorksheetFunction.Sum(hoja2.Range("E7:E28")) hoja2.Range("F29").Value = Application.WorksheetFunction.Sum(hoja2.Range("F7:F28")) hoja2.Range("E30").Value = hoja2.Range("E29").Value - hoja2.Range("F29").Value End Sub RESUMEN CARGA LIQUIDACION A SISTEMA.xlsm

Prueba y comenta