Sub Выгрузить()
Set rb = ThisWorkbook.Worksheets("Задачи зафиксированные")
Set ob = ThisWorkbook.Worksheets("Ошибки зафиксированные")
Set rbi = ThisWorkbook.Worksheets("Задачи измененные")
Set obi = ThisWorkbook.Worksheets("Ошибки измененные")
Set wb = ThisWorkbook.Worksheets("Управление")
Name = Format(wb.Cells(1, 1), "yyyy") & "-" & Format(wb.Cells(1, 1), "mm")
Workbooks.Add
ActiveWorkbook.SaveAs ("C:\Отчет по анализу задач " & Name & ".xlsx")
Set pb = ActiveWorkbook
Dim gb As Worksheet
l = 1
For h = 2 To ob.Cells(1, 1).CurrentRegion.Rows.Count
    If ob.Cells(h, 13) <> "" Then n = ob.Cells(h, 4).Value Else GoTo EndFor1 'определяю имя листа
    On Error Resume Next
'определяю наличие листа с таким именем
    Set gb = Worksheets(n)
        If Err.Number <> 0 Then
            pb.Sheets.Add().Name = n 'если нет такого листа я его генерю
            Set gb = pb.Worksheets(n) 
        Else
            Set gb = pb.Worksheets(n) 'Если есть лист я его переиспользую
        End If
          
            j = gb.Cells(1, 1).CurrentRegion.Rows.Count + 1 'определяю пустую строчку после заполненной в листе
'произвожу копирование данных по признаку
            ob.Cells(h, 1).Copy gb.Cells(j, 1) 'номер
            gb.Cells(j, 2) = ob.Cells(h, 2) ' описание
            Comment_Copy gb.Cells(j, 2), ob.Cells(h, 2) ' пояснение
            gb.Cells(j, 3) = ob.Cells(h, 3)  ' тип
            gb.Cells(j, 4) = ob.Cells(h, 5)  ' проект
            gb.Cells(j, 5) = ob.Cells(h, 6)  ' стаиус
            gb.Cells(j, 6) = ob.Cells(h, 13)  ' документация

EndFor1:
Next
'Закрываем файл
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub

If gb Is Nothing Then pb.Sheets.Add().Name = n

Sub Выгрузить()
Set ob = ThisWorkbook.Worksheets("Ошибки зафиксированные")
Set wb = ThisWorkbook.Worksheets("Управление")
Name = Format(wb.Cells(1, 1), "yyyy") & "-" & Format(wb.Cells(1, 1), "mm")
Workbooks.Add
ActiveWorkbook.SaveAs ("C:\Отчет по анализу задач " & Name & ".xlsx")
Set pb = ThisWorkbook

For h = 2 To ob.Cells(1, 1).CurrentRegion.Rows.Count
    If ob.Cells(h, 13) <> "" Then n = ob.Cells(h, 4).Value
    Do
        If Not pb.WorksheetExist(n) Then pb.Sheets.Add().Name = n
            Set gb = ThisWorkbook.Worksheets(n)
            j = gb.Worksheets(n).Cells(1, 1).CurrentRegion.Rows.Count
            ob.Cells(h, 1).Copy gb.Cells(j, 1) 'номер
            gb.Cells(j, 2) = ob.Cells(h, 2) ' описание
            Comment_Copy gb.Cells(j, 2), ob.Cells(h, 2) ' пояснение
            gb.Cells(j, 3) = ob.Cells(h, 3)  ' тип
            gb.Cells(j, 4) = ob.Cells(h, 5)  ' проект
            gb.Cells(j, 5) = ob.Cells(h, 6)  ' стаиус
            gb.Cells(j, 6) = ob.Cells(h, 13)  ' документация
            Exit Do
    Loop
Next
'Закрываем файл
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub

 if FileDateTime(sFolder & Dir(sFolder & "*.xls*"))="today_" & Format(Date, "YYYYMMDD") then fname=sFolder & Dir(sFolder & "*.xls*")

Sub Ìàêðîñ1()

Dim ls1 As Long
Dim wb, Db As Worksheet
Set wb = ThisWorkbook.Sheets(1)
Set Db = ThisWorkbook.Sheets(2)

ls1 = Db.Cells(Rows.Count, 1).End(xlUp).Row
wb.Cells(5, 1).Delete
Names.Add Name:="test", RefersTo:="=Ëèñò2!$A$1:$A$" & ls1

wb.Cells(5, 1).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=test"

End Sub

Sub обновить()
Dim arr As Variant

Dim OshW(8) As String
      OshW(0) = "Изменение процесса без отчетности, с требованиями"
      OshW(1) = "Изменение отчета без процесса, с требованиями"
      OshW(2) = "Изменение процесса и отчета, с требованиями"
      OshW(3) = "Изменение процесса без отчетности, без требований"
      OshW(4) = "Изменение отчета без процесса, без требований"
      OshW(5) = "Изменение процесса и отчета, без требований"
      OshW(6) = "Технические изменения"
      OshW(7) = "Не удалось классифицировать"
      u1 = Join(OshW, ",")
      arr = Range("h1:h8")
     'Names.Add "List1", arr
     'u2 = Join(arr, ",")
     ActiveWorkbook.Names.Add Name:="ggg", RefersToR1C1:="=Лист1!R1C8:R8C8"
      Cells(2, 2).Validation.Delete
'Cells(2, 2).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=u1
'Cells(2, 2).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=List1
Cells(2, 2).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=ggg

End Sub

Sub обновить()

Dim OshW(8) As String
 OshW(0) = "Изменение процесса без отчетности, с требованиями"
      OshW(1) = "Изменение отчета без процесса, с требованиями"
      OshW(2) = "Изменение процесса и отчета, с требованиями"
      OshW(3) = "Изменение процесса без отчетности, без требований"
      OshW(4) = "Изменение отчета без процесса, без требований"
      OshW(5) = "Изменение процесса и отчета, без требований"
      OshW(6) = "Технические изменения"
      OshW(7) = "Не удалось классифицировать"
      u1 = Join(OshW, ",")
Cells(2, 2).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=u1

End Sub