Sub tt_()
Dim sh As Worksheet
Dim shName As String
Dim IlastRow&
Dim YYY_&, YYY_1&, YYY_2&, YYY_3&

YYY_3 = Sheets("в работе").Cells(Rows.Count, 1).End(xlUp).Row
    If YYY_3 <> 1 Then
        Range("A2:D" & YYY_3).ClearContents
    End If
    For Each sh In ActiveWorkbook.Worksheets
        shName = sh.Name
         If shName <> "в работе" And shName <> "ГРАФИК РАБОТ" Then
            With Sheets(shName)
                YYY_ = .Cells(Rows.Count, 3).End(xlUp).Row
                .Range("$B$3:$J" & YYY_).AutoFilter Field:=9, Criteria1:="в работе"
                YYY_1 = .Cells(Rows.Count, 3).End(xlUp).Row
                .Range("C4:F" & YYY_1).SpecialCells(xlCellTypeVisible).Copy
                YYY_2 = Sheets("в работе").Cells(Rows.Count, 1).End(xlUp).Row
                Sheets("в работе").Range("A" & YYY_2 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                .Range("$B$3:$J" & YYY_).AutoFilter Field:=9
            End With
         End If
       Next
      
End Sub

                          
Sub tt()
    Dim sh As Worksheet
    Application.ScreenUpdating = 0
    cal_ = Application.Calculation
    Application.Calculation = 0
    r0_ = 3 'шапка на листах
    c_ = 9 'столбец статуса
    t_ = "в работе"
    nc_ = 4 'кол столбцов для переноса
    r1_ = Cells(Rows.Count, 1).End(xlUp).Row
    If r1_ <> 1 Then
        Cells(2, 1).Resize(r1_ - 1, nc_).ClearContents
    End If
    For Each sh In ThisWorkbook.Worksheets
        With sh
            If IsDate(.Name) Then
                k_ = k_ + .Cells(Rows.Count, c_ + 1).End(xlUp).Row - r0_
            End If
        End With
    Next sh
    ar = Cells(2, 1).Resize(k_, 4)
    If k_ Then
        For Each sh In ThisWorkbook.Worksheets
            With sh
                If IsDate(.Name) Then
                    n_ = .Cells(Rows.Count, c_ + 1).End(xlUp).Row - r0_
                    If n_ Then
                        ar1 = .Cells(r0_ + 1, 2).Resize(n_, c_)
                        For i = 1 To n_
                            If ar1(i, c_) = t_ Then
                    z_ = z_ + 1
                    For j = 1 To nc_
                    ar(z_, j) = ar1(i, j + 1)
                    Next j
                            End If
                        Next i
                    End If
                End If
            End With
        Next sh
        Cells(2, 1).Resize(z_, 4) = ar
    End If
    Application.Calculation = cal_
    Application.ScreenUpdating = 1
End Sub