Private Sub ComboBox212_AfterUpdate()
        i = 1
            Do While ThisWorkbook.Sheets(2).Cells(i, 1) <> ""
                i = i + 1
            Loop
            ThisWorkbook.Sheets(2).Cells(i, 1) = ComboBox212.Value
        Me.ComboBox113.Value = Me.ComboBox212.Value
        If Me.TextBox212.Value = "" Then        ' Вот это разве возможно если что то ввели в ComboBox?
        Me.TextBox212.Value = Me.TextBox211.Value ' Если TextBox211 пустой то что в итоге?
        End If
        Call UserForm_Activate 'это для чего?
        End Sub

Sub test_arr()
    Dim arr(), i&, j&
    arr = [a1].CurrentRegion.Offset(1, 0).Value
    For i = 1 To UBound(arr)
        If arr(i, 1) <> 4 Then
            j = j + 1
            For k = 1 To UBound(arr, 2)
                arr(j, k) = arr(i, k)
            Next k
        End If
    Next i
    [e30].Resize(j, UBound(arr, 2)).Value = arr
End Sub

Sub SheetsDel()
    Dim sh As Worksheet
    Dim lrow&, arr(), ikey
    Set sh = Worksheets("Имя листа со списком")
    With sh
        lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range(.[a7], .Cells(lrow, 1)).Value
    End With
    Application.DisplayAlerts = False
    On Error Resume Next
    For Each ikey In arr
        Set sh = Worksheets(ikey)
        If Not sh Is Nothing Then sh.Delete
    Next
    Application.DisplayAlerts = True
End Sub

Sub iSheetsDel()
'    ------------------------
    Dim sht As Worksheet
    Dim arr(), ikey, lrow&
    Dim coll As Collection
'    ------------------------
    Application.DisplayAlerts = False
    Set coll = New Collection
    Set sht = Worksheets("sheet1")
    With sht
        lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range(.[a7], .Cells(lrow, 1)).Value
    End With
    On Error Resume Next
    For Each ikey In arr
        coll.Add ikey, CStr(ikey)
    Next ikey
    For Each sht In Worksheets
        coll.Add sht.Name, CStr(sht.Name)
        If Err.Number <> 0 Then sht.Delete: Err.Clear
    Next sht
    On Error GoTo 0
    Application.DisplayAlerts = True
End Sub

Sub ПереносДанных()
    Dim arr(), iarr$
    Const iPath$ = "Путь к файлу получателю"
    Const lPath = "Путь к файлу донору"
    Application.DisplayAlerts = False
    With GetObject(lPath).Worksheets(1)
        arr = .[a1].CurrentRegion.Value
        .Parent.Close False
    End With
    If Not IsArray(arr) Then Exit Sub
    With GetObject(iPath).Worksheets(1)
        .[a1].Resize(UBound(arr), UBound(arr, 2)).Value = arr
        .Parent.Close True
    End With
    Workbooks.Open (iPath)
    iarr = Split(iPath, "\")(UBound(Split(iPath, "\")))
    Windows(iarr).Visible = True
    Application.DisplayAlerts = True
End Sub

Private Sub CommandButton1_Click()
    Dim sht As Worksheet
    For Each sht In ThisWorkbook.Worksheets
        sht.Visible = xlSheetVisible
    Next sht
End Sub