Option Explicit

Private Sub Workbook_Open()
    Dim i           As Long
    Application.ScreenUpdating = False
    ThisWorkbook.Worksheets("Sheet1").Range("B2:B" & ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row).ClearContents

    For i = 1 To Sheets.Count

        If ThisWorkbook.Sheets(i).Name <> "Sheet1" Then
            Application.DisplayAlerts = False
            ThisWorkbook.Worksheets("Sheet1").Cells(i, 2) = Sheets(i).Name
            Application.DisplayAlerts = True
        End If

    Next

    Application.ScreenUpdating = True
End Sub

Option Explicit

Private Sub Worksheet_Activate()
    Dim i As Long, iRow As Long
    Dim t           As Range
    Dim btn         As Button
    iRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
    Application.ScreenUpdating = False
    ActiveSheet.Buttons.Delete

    For i = 2 To iRow
        Set t = ActiveSheet.Range(Cells(i, 3), Cells(i, 3))
        Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)

        With btn
            .OnAction = "btnS" & i
            .Caption = ActiveSheet.Cells(i, 2).Text
            .Name = "CommandButton" & i
        End With

    Next i

    Application.ScreenUpdating = True
End Sub

Option Explicit

Private Sub ListBox1_Click()

    ' 1
    Dim sRow As Long, sc As Long
    If ListBox1.ListIndex = -1 Then Exit Sub
    sc = ListBox1.ListIndex

    Me.TextBox1 = ""

    If Err.Number = 0 Then

        If Me.ListBox1.List(Me.ListBox1.ListIndex, 0) <> "" Then
            sRow = ListBox1.ListIndex + 8
            ThisWorkbook.Worksheets("Sheet2").Range("A" & sRow & ":S" & sRow).Select

            Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
            '            Me.TextBox2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0)
        End If

    Else
        Err.Clear
        MsgBox ("Произошла Ошибка! "), vbCritical
        Unload Me
    End If

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ThisWorkbook.Worksheets("Sheet1").Activate
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    ThisWorkbook.Worksheets("Sheet2").Activate

    ' 1
    With ThisWorkbook.Worksheets("Sheet2")

        With .Range("B8:B" & .Columns("A").Find(what:="*", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row)
            Me.ListBox1.List = .Parent.Evaluate("filter(" & .Address & "," & .Resize(, 1).Address & "<>"""")")
        End With

    End With

End Sub

Option Explicit
Dim iArr As Variant

Private Sub UserForm_Initialize()

    With Worksheets("Sheet1")
        iArr = .Range("A2:H" & .Cells(Rows.Count, 8).End(xlUp).SpecialCells(xlCellTypeVisible).Row).Value           ' .Row).Value
    End With

    '    отображаем список
    Me.ListBox1.List = iArr
    Me.ListBox1.ColumnCount = 8
    Me.ListBox1.ColumnWidths = "220,180,100,50,50,50,50,50"
End Sub

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Set ws1 = Sheet1
    Set tbl = ws1.ListObjects("Table1")
    Set NewRow = tbl.ListRows.Add

    With NewRow.Range

        Set RngCol = tbl.HeaderRowRange.Find(Me.ComboBox1.Value, , LookIn:=xlValues, LookAt:=xlWhole)

        If Not RngCol Is Nothing Then
            .Columns(RngCol + 1) = Me.TextBox1
        Else
            .Columns(RngCol + 1) = ""
        End If

    End With

    Application.ScreenUpdating = True
    Unload Me
    MsgBox "Данные введены, Удачи!"
End Sub

Option Explicit

Sub Find()
    Dim fDate As Range, iDate As Variant
    Application.ScreenUpdating = False

    iDate = Format("mmm-yy")
    Set fDate = Sheet1.Columns(2).Find(iDate, , xlFormulas, xlWhole)

    If fDate Is Nothing Then
        MsgBox iDate & " не найдено", vbExclamation, "Ошибка"
        Exit Sub
    End If

    Sheet1.Activate
    fDate.Select
    ActiveCell.Offset(0, 1) = ActiveCell.Offset(0, 1) + "Yes"

    Application.ScreenUpdating = True
End Sub