Buscar 5 variable que esten en una misma linea

Buenas, estoy con un problema ya que debo buscar 5 variables tomadas
de una hoja (que están en una misma línea) y buscarlas en otra hoja
(principal) donde esten en una misma línea. Si las encuentra, copia
otros 2 valores y los agrega en la columna correspondiente. Si no las
encuentra, agrega estas 5 mas los otros dos valores en una nueva
línea.

Esto lo hace desde varías hojas de donde obtiene el valor de las
variables, y copia todo en la hoja principal donde junto los datos de
todas las hojas, lo que hace que llegue un momento que son muchas
líneas donde tiene que comparar.

Existe una forma mas facil de realizar esta comparación no sea linea x
linea, sino algo parecido a un "Find"?
Puede ser un tema de memoria?

Dejo la parte del código que trae problemas.

'--Create the annual consolidation--

Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Consolidated"
ActiveSheet.Tab.ColorIndex = 11
Set WSD2 = Worksheets(ActiveSheet.Name)

Dim ws As Worksheet

lCol = 7

For Each ws In ActiveWorkbook.Worksheets

'Check if the sheetŽs name contains Table
ShName = ws.Name
sText = "Table"
lText = Right$(ShName, 5)

If lText = sText Then

a = 2

Do
StartRow = WSD2.Cells(Application.Rows.Count, 2).End
(xlUp).Row

Program = ws.Cells(a, 2)
Platform = ws.Cells(a, 4)
Devices = ws.Cells(a, 5)
Operator = ws.Cells(a, 6)
Title = ws.Cells(a, 3)
Total = Format(ws.Cells(a, 7), "###0.00")
TimeS = Format(ws.Cells(a, 8).Value, "Percent")

'Find if already exists in sheet

b = 2

Do

If WSD2.Cells(b, 2) = Program And _
WSD2.Cells(b, 3) = Title And _
WSD2.Cells(b, 4) = Platform And _
WSD2.Cells(b, 5) = Devices And _
WSD2.Cells(b, 6) = Operator Then

WSD.Cells(b, lCol) = CDec(Total)
WSD.Cells(b, lCol + 1) = Format(TimeS,
"Percent")
WSD.Cells(b, 8).TextToColumns
Destination:=WSD2.Cells(b, lCol + 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote,
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False,
Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

b = 2
Found = "Yes"
Exit Do

Else
b = b + 1
If Cells(b, 2) = "" Then
Found = "No"
Exit Do
End If
End If

Loop

If Found = "No" Then
StartRow = StartRow + 1
WSD2.Cells(StartRow, 1) = "Mobile"
WSD2.Cells(StartRow, 2) = Program
WSD2.Cells(StartRow, 3) = Title
WSD2.Cells(StartRow, 4) = Platform
WSD2.Cells(StartRow, 5) = Devices
WSD2.Cells(StartRow, 6) = Operator
WSD2.Cells(StartRow, lCol) = CDec(Total)
WSD2.Cells(StartRow, lCol + 1) = TimeS
WSD2.Cells(StartRow, lCol + 1).TextToColumns
Destination:=WSD2.Cells(StartRow, lCol + 1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote,
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False,
Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
b = 2
End If

a = a + 1

If ws.Cells(a, 1) = "" And ws.Cells(a, 2) = "" And
ws.Cells(a, 3) = "" And ws.Cells(a, 4) = "" And ws.Cells(a, 5) = ""
And ws.Cells(a, 6) = "" Then Exit Do

Loop

'-get the name for column headers
ShName = ws.Name
sText = "Table"
lText = Left(ShName, 6)
Cells(1, lCol) = lText
Cells(1, lCol + 1) = "%Time Spent for " & lText

lCol = lCol + 2

End If

Next


Muchisimas gracias!!