Problemas con Find

[CECILIO]

Buenas tardes a todos
acudo a ustedes para solicitar su ayuda como de costumbre ya que me he atorado con una rutina Tengo archivo "Problema" de la cual manejo básicamente las siguientes Hojas:
Hoja1
Hoja3
Pretendo buscar el código del empleado de la Hoja3 columna "B", realizar la Búsqueda en la Hoja1 columna"A" y si se encuentra
y ademas en la fila donde se ubique, columna "F" sea mayor a 0 (Cero), copiarlo y realizar el pegado en la Hoja3 en la fila que corresponda , de lo que he desarrollado únicamente lo realiza con la columna de Horas Extras ,pero no se por que no lo hace con el resto de las columnas, espero haber sido explicito, Gracias
La macro lo puse en la Hoja3

problema.xlsm

[rolano]

Sub MAC()

Application.ScreenUpdating = False
Set H1 = Sheets("Hoja1")
Set H2 = Sheets("Hoja3")
ultimfb = H2.Range("B" & Rows.Count).End(xlUp).Row + 1
H2.Range("B4" & ": AV" & ultimfb).Clear



H1.Activate
Range("A9").Select
Do While ActiveCell <> "FIN"


If Len(ActiveCell.Value) = 6 Then
    ultimfd = H2.Range("B" & Rows.Count).End(xlUp).Row + 1
         ActiveCell.Offset(0, 0).Copy
         H2.Range("B" & ultimfd).PasteSpecial xlValues
 End If
            ActiveCell.Offset(1, 0).Select
  Loop
  
  H2.Activate
    
   'ultimf = Range("AV" & Rows.Count).End(xlUp).Row
   For i = 4 To H2.Range("b" & Rows.Count).End(xlUp).Row
       
        Set b = H1.Range("A:A").Find(H2.Cells(i, "b"), lookat:=xlPart)
            
            If Not b Is Nothing Then
                H1.Range("B" & b.Row).Copy
                H2.Cells(i, "C").PasteSpecial xlValues
                
            If Not b Is Nothing And H1.Range("C" & b.Row) > 0 Then
            
                H1.Range("C" & b.Row).Copy
                H2.Cells(i, "D").PasteSpecial xlValues
            
            
            If Not b Is Nothing And H1.Range("D" & b.Row) > 0 Then
                H1.Range("D" & b.Row).Copy
                H2.Cells(i, "E").PasteSpecial xlValues
                
            If Not b Is Nothing And H1.Range("E" & b.Row) > 0 Then
                H1.Range("E" & b.Row).Copy
                H2.Cells(i, "F").PasteSpecial xlValues
            
            If Not b Is Nothing And H1.Range("F" & b.Row) >= 0 Then
              
                H1.Range("F" & b.Row).Copy
                H2.Cells(i, "G").PasteSpecial xlValues

            If Not b Is Nothing And H1.Range("G" & b.Row) >= 0 Then
              
                H1.Range("G" & b.Row).Copy
                H2.Cells(i, "H").PasteSpecial xlValues
            
            End If
            End If
            End If
            End If
            End If
            End If
            
   Next i
    ' a raiz de que en las columnas G, H y demas columnas hacia la derecha ya no me copia valores que sean mayores a cero (0) me vi en la necesidad
    'de entrar nuevamente a un nuevo ciclo ignoro si el if en vba tenga limitante
'    For t = 4 To H2.Range("b" & Rows.Count).End(xlUp).Row
'          Set b1 = H1.Range("A:A").Find(H2.Cells(t, "b"), lookat:=xlPart)
'
'            If Not b1 Is Nothing And H1.Range("f" & b.Row) > 0 Then
'
'                H1.Range("F" & b.Row).Copy
'                H2.Cells(t, "G").PasteSpecial xlValues
'
'            If Not b1 Is Nothing And H1.Range("f" & b.Row) > 0 Then
'
'                H1.Range("G" & b.Row).Copy
'                H2.Cells(t, "H").PasteSpecial xlValues
'
''MsgBox "Fin"
' End If
' End If
 'Next t
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Hola Cecilio, la condición tiene que ser mayor igual a 0, porque en la hoja 1 tienes valores (0)..

[CECILIO]

adjunto nuevamente archivo actualizado , pretendo de la Hoja 1 Pasar todos las cantidades ya no me importa si lleva o ceros o no pero si que lo de sueldos de la hoja 1 se vaya a la columna de sueldos hoja3 ,realizar una suma de los conceptos posteriormente copiar encabezados( D3:AV3) y pegarlo de forma traspuesta como lo muestra la HOJA 3  Rango AY4 y realizar un resumen 

por favor necesito ayuda ya me bloquee , Gracias

problemaactaulizado.xlsm problemaactaulizado.zip

[rolano]

Hola Cecilio, adjunto el código para que lo reescribas en tu proyecto.