Se podria hacer que la celda donde pone JUAN SL lo copie como valor en la hoja resumen?hay alguna manera que si en alguna ho

H o l a : En un correo nuevo.

Envíame un archivo de ejemplo, con 4 hojas de la siguiente forma:

2 hojas con datos

1 hoja sin datos

1 hoja con el resumen de las 3 hojas anteriores; el resumen contendrá solamente lo datos de 2 hojas, porque la tercera no tiene datos, solamente es para probar que no copie el encabezado.

Para hacer más rápido la macro, necesito que me comentes lo siguiente:

1. ¿Cuánto tiempo tarda la macro con las 150 hojas?

2. La hoja "resumen" debe estar al principio de todas las hojas.

3. Los gastos empiezan en la fila 12

4. Las ventas empiezan en la fila 610

5. Si en las celdas D12 y D610 están vacías significa que la hoja no tiene datos, por lo tanto no se debe poner el encabezado.

6. Si en las celda D12 hay datos, en la celda D13 ha datos, en la celda D14 hat datos, en la celda D15 NO hay datos, entonces que la macro se detenga y revise la celda D610, si en la celda D610 hay datos, en la D611 NO hay datos, que la macro se detenga y pase a la siguiente hoja.

; E spero tus comentarios en ese orden. Sal u dos

Te anexo la macro

Sub Resumen()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.StatusBar = False
    Set h1 = Sheets("RESUMEN")
    h1.Cells.Clear
    If h1.Name <> Sheets(1).Name Then
        MsgBox "La hoja resumen debe ir al principio"
        Exit Sub
    End If
    j = 1
    numhojas = Sheets.Count
    For h = 2 To numhojas
        Application.StatusBar = "Procesando hoja: " & h & " de: " & numhojas
        Set h2 = Sheets(h)
        n = j
        j = j + 1
        gastos = WorksheetFunction.Count(h2.Range("T3:T602"))
        If gastos > 0 Then
            For Each celda In h2.Range("T3:T602").SpecialCells(xlCellTypeConstants, 23)
                h2.Rows(celda.Row).Copy h1.Cells(j, "A")
                j = j + 1
            Next
        End If
        ventas = WorksheetFunction.Count(h2.Range("T610:T810"))
        If ventas > 0 Then
            For Each celda In h2.Range("T610:T810").SpecialCells(xlCellTypeConstants, 23)
                h2.Rows(celda.Row).Copy h1.Cells(j, "A")
                j = j + 1
            Next
        End If
        If n + 1 = j Then
            j = j - 1
        Else
            h1.Cells(n, "D") = h2.Range("D1")
        End If
    Next
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "Fin"
End Sub

La macro hace el resumen de la columna "T", cambia la "T" por la letra de la columna que desees en estas líneas:

        gastos = WorksheetFunction.Count(h2.Range("T3:T602"))
        If gastos > 0 Then
            For Each celda In h2.Range("T3:T602").SpecialCells(xlCellTypeConstants, 23)
                h2.Rows(celda.Row).Copy h1.Cells(j, "A")
                j = j + 1
            Next
        End If
        ventas = WorksheetFunction.Count(h2.Range("T610:T810"))
        If ventas > 0 Then
            For Each celda In h2.Range("T610:T810").SpecialCells(xlCellTypeConstants, 23)
                h2.Rows(celda.Row).Copy h1.Cells(j, "A")
                j = j + 1
            Next
        End If

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

¡Gracias! 

me da error te lo paso por mail

si pongo para que me busque en la columna r me da error