При открытии (UserForm) нет возможности копировать данные с ячеек EXCEL и т.д

Private Const DATABASE_SHEET_NAME As String = "База данных"
Private Const LOG_SHEET_NAME As String = "Журнал изменений"
 
Private currentRow As Long
Private lastRow As Long
 
Private Sub UserForm_Initialize()
    '*** Дата и время опроса ***
    txtSurveyDate.Text = Format(Now(), "dd.mm.yyyy hh:mm:ss")
    txtSurveyDate.Enabled = False 'Блокируем возможность редактирования
 
    '*** ФИО проводившего опрос ***
    txtSurveyConductedBy.Text = Application.UserName
    txtSurveyConductedBy.Enabled = False 'Блокируем возможность редактирования
 
    cboOwnerUser.Clear
    cboOwnerUser.AddItem "Владелец"
    cboOwnerUser.AddItem "Пользователь"
 
    cboConfirmation.Clear
    cboConfirmation.AddItem "Оценка не подтверждена"
    cboConfirmation.AddItem "Оценка подтверждена"
 
    cboReasonLowRating.Clear
    cboReasonLowRating.AddItem "Интернет"
    cboReasonLowRating.AddItem "Продукт/тариф"
    cboReasonLowRating.AddItem "Продукт/услуга"
    cboReasonLowRating.AddItem "Связь"
    cboReasonLowRating.AddItem "Связь/интернет"
    cboReasonLowRating.AddItem "Начисление"
    cboReasonLowRating.AddItem "Обслуживание"
    cboReasonLowRating.AddItem "Другое"
    cboReasonLowRating.AddItem "Нет"
 
    cboGender.Clear
    cboGender.AddItem "М"
    cboGender.AddItem "Ж"
 
    cboStatus.Clear
    cboStatus.AddItem "В работе"
    cboStatus.AddItem "Закрыто"
 
    cboResult.Clear
    cboResult.AddItem "Стал промоутером"
    cboResult.AddItem "Стал нейтралом"
    cboResult.AddItem "Остался детрактором"
    cboResult.AddItem "Ответ по SMS"
    cboResult.AddItem "Требуется повторный звонок"
    cboResult.AddItem "Отказ от разговора"
    cboResult.AddItem "Не предоставил данные"
 
    cboQuestionResolution.Clear
    cboQuestionResolution.AddItem "Решен"
    cboQuestionResolution.AddItem "Не решен"
    cboQuestionResolution.AddItem "Будет решен"
    cboQuestionResolution.AddItem "Вопросов нет"
 
    cboArea.Clear
    cboArea.AddItem "Ташкент.обл."
    cboArea.AddItem "Сурхандарья"
    cboArea.AddItem "Каракалпак"
    cboArea.AddItem "Сырдарья"
    cboArea.AddItem "Бухара"
    cboArea.AddItem "Наманган"
    cboArea.AddItem "Фергана"
    cboArea.AddItem "Андижан"
    cboArea.AddItem "Хорезм"
    cboArea.AddItem "Джиззак"
    cboArea.AddItem "Ташкент"
    cboArea.AddItem "Самарканд"
    cboArea.AddItem "Кашкадаря"
    cboArea.AddItem "Навои"
 
    With cboProblem
        .AddItem "0"
        .AddItem "1"
    End With
 
    cboRatingSurvey.Clear
    Dim i As Integer
    For i = 0 To 10
        cboRatingSurvey.AddItem i
    Next i
 
    ClearForm
End Sub
 
Private Sub ClearForm()
    txtAssessmentDate.Text = ""
    txtSubscriberName.Text = ""
    txtSubscriberNumber.Text = ""
    txtReasonDetails.Text = ""
    txtNextSteps.Text = ""
    txtMeasuresTaken.Text = ""
    txtBSNumber.Text = ""
    txtBSState.Text = ""
    txtRegion.Text = ""
    txtCommentsResults.Text = ""
    txtTicketNumber.Text = ""
    txtTariff.Text = ""
 
    cboOwnerUser.Value = ""
    cboReasonLowRating.Value = ""
    cboConfirmation.Value = ""
    cboGender.Value = ""
    cboArea.Value = ""
    cboRatingSurvey.Value = ""
    cboStatus.Value = ""
    cboResult.Value = ""
    cboQuestionResolution.Value = ""
    cboProblem.Value = ""
End Sub
 
Private Sub cmdFirst_Click()
    With GetDatabaseSheet()
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    End With
 
    If lastRow < 2 Then
        MsgBox "В базе данных нет записей.", vbInformation
        Exit Sub
    End If
 
    If currentRow = 2 Then
        MsgBox "Это первая запись.", vbInformation
    Else
        currentRow = 2
        LoadDataToForm
    End If
End Sub
 
Private Sub cmdPrevious_Click()
    With GetDatabaseSheet()
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    End With
 
    If lastRow < 2 Then
        MsgBox "В базе данных нет записей.", vbInformation
        Exit Sub
    End If
 
    If currentRow > 2 Then
        currentRow = currentRow - 1
        LoadDataToForm
    Else
        MsgBox "Это первая запись.", vbInformation
    End If
End Sub
 
Private Sub cmdNext_Click()
    With GetDatabaseSheet()
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    End With
 
    If lastRow < 2 Then
        MsgBox "В базе данных нет записей.", vbInformation
        Exit Sub
    End If
 
    If currentRow < lastRow Then
        currentRow = currentRow + 1
        LoadDataToForm
    Else
        MsgBox "Это последняя запись.", vbInformation
    End If
End Sub
 
Private Sub cmdLast_Click()
    With GetDatabaseSheet()
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    End With
 
    If lastRow < 2 Then
        MsgBox "В базе данных нет записей.", vbInformation
        Exit Sub
    End If
 
    If currentRow = lastRow Then
        Dim ws As Worksheet
        Set ws = GetDatabaseSheet()
 
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        currentRow = 0
 
        ClearForm
        txtSurveyDate.Text = Format(Now(), "dd.mm.yyyy hh:mm:ss")
        txtSurveyConductedBy.Text = Application.UserName
        LoadDataToForm
        lblID.caption = "ID:"
        MsgBox "Можете вводить новые дынные по опросу", vbInformation
    Else
        currentRow = lastRow
        LoadDataToForm
        MsgBox "Это последняя запись.", vbInformation
    End If
End Sub
 
Private Sub LoadDataToForm()
    Dim ws As Worksheet
    Set ws = GetDatabaseSheet()
 
    If currentRow < 2 And currentRow <> 0 Then
        MsgBox "Недопустимое значение currentRow: " & currentRow, vbCritical
        Exit Sub
    End If
 
    With ws
        If currentRow > 0 Then
            lblID.caption = "ID: " & .Cells(currentRow, 2).Value
            txtSubscriberName.Text = .Cells(currentRow, 1).Value
            txtSubscriberNumber.Text = .Cells(currentRow, 3).Value
            txtTariff.Text = .Cells(currentRow, 4).Value
            txtAssessmentDate.Text = Format(.Cells(currentRow, 5).Value, "dd.mm.yyyy")
            '*** Устанавливаем дату и время из базы данных
            txtSurveyDate.Text = Format(.Cells(currentRow, 6).Value, "dd.mm.yyyy hh:mm:ss")
 
            cboOwnerUser.Value = .Cells(currentRow, 7).Value
            cboReasonLowRating.Value = .Cells(currentRow, 8).Value
            cboConfirmation.Value = .Cells(currentRow, 9).Value
            cboGender.Value = .Cells(currentRow, 10).Value
            txtReasonDetails.Text = .Cells(currentRow, 11).Value
            txtNextSteps.Text = .Cells(currentRow, 12).Value
            txtMeasuresTaken.Text = .Cells(currentRow, 13).Value
            txtBSNumber.Text = .Cells(currentRow, 14).Value
            txtBSState.Text = .Cells(currentRow, 15).Value
            cboProblem.Value = CStr(.Cells(currentRow, 16).Value)
            cboArea.Value = .Cells(currentRow, 17).Value
            txtRegion.Text = .Cells(currentRow, 18).Value
            txtCommentsResults.Text = .Cells(currentRow, 19).Value
            cboRatingSurvey.Value = .Cells(currentRow, 20).Value
            cboStatus.Value = .Cells(currentRow, 21).Value
            cboResult.Value = .Cells(currentRow, 22).Value
            cboQuestionResolution.Value = .Cells(currentRow, 24).Value
            txtSurveyConductedBy.Text = .Cells(currentRow, 25).Value
            txtTicketNumber.Text = .Cells(currentRow, 26).Value
        Else
            lblID.caption = "ID:"
        End If
    End With
End Sub
 
Private Sub btnSave_Click()
    Dim ws As Worksheet, logWs As Worksheet
    Dim assessmentDate As Date, surveyDate As Date
    Dim rating As Integer, newID As Long
    Dim logRow As Long, editCol As Long
    Dim isNumericValid As Boolean
    Dim i As Long
    Dim idToFind As Long, foundRow As Long
    Dim lastColumn As Long
 
    ' --- Получаем листы ---
    Set ws = GetDatabaseSheet()
    Set logWs = GetLogSheet()
 
    '=== Проверка формата даты и преобразование ============================
    If Not IsDate(txtAssessmentDate.Text) Then
        MsgBox "Неверный формат даты в поле 'Дата оценки'", vbExclamation
        Exit Sub
    End If
    assessmentDate = CDate(txtAssessmentDate.Text)
 
    ' === проверка, что оценка это число от 0 до 10 =========================
    If Not IsNumeric(cboRatingSurvey.Value) Then
        MsgBox "Оценка по итогу опроса должна быть числом от 0 до 10.", vbCritical, "Ошибка ввода"
        Exit Sub
    End If
    rating = CInt(cboRatingSurvey.Value)
    If rating < 0 Or rating > 10 Then
        MsgBox "Оценка по итогу опроса должна быть числом от 0 до 10.", vbCritical, "Ошибка ввода"
        Exit Sub
    End If
 
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
 
    '=== Записываем данные =================================================
    If currentRow > 1 And currentRow <= lastRow Then 'Редактируем запись
        ws.Cells(currentRow, 1).Value = txtSubscriberName.Text
        ws.Cells(currentRow, 3).Value = txtSubscriberNumber.Text
        ws.Cells(currentRow, 4).Value = txtTariff.Text
        ws.Cells(currentRow, 16).Value = cboProblem.Value
        ws.Cells(currentRow, 7).Value = cboOwnerUser.Value
        ws.Cells(currentRow, 8).Value = cboReasonLowRating.Value
        ws.Cells(currentRow, 9).Value = cboConfirmation.Value
        ws.Cells(currentRow, 10).Value = cboGender.Value
        ws.Cells(currentRow, 11).Value = txtReasonDetails.Text
        ws.Cells(currentRow, 12).Value = txtNextSteps.Text
        ws.Cells(currentRow, 13).Value = txtMeasuresTaken.Text
        ws.Cells(currentRow, 14).Value = txtBSNumber.Text
        ws.Cells(currentRow, 15).Value = txtBSState.Text
        ws.Cells(currentRow, 17).Value = cboArea.Value
        ws.Cells(currentRow, 18).Value = txtRegion.Text
        ws.Cells(currentRow, 19).Value = txtCommentsResults.Text
        ws.Cells(currentRow, 20).Value = rating
        ws.Cells(currentRow, 21).Value = cboStatus.Value
        ws.Cells(currentRow, 22).Value = cboResult.Value
        ws.Cells(currentRow, 24).Value = cboQuestionResolution.Value
        ws.Cells(currentRow, 25).Value = txtSurveyConductedBy.Text 'Провёл опрос
        ws.Cells(currentRow, 26).Value = txtTicketNumber.Text 'Номер заявки
        ws.Cells(currentRow, 5).Value = assessmentDate
 
        'Ищем запись в журнале по ID
        idToFind = ws.Cells(currentRow, 2).Value 'ID записи в базе данных
        foundRow = 0
 
        'Проходим по всем записям в журнале, начиная со второй строки (первая - заголовки)
        For i = 2 To logWs.Cells(logWs.Rows.Count, "A").End(xlUp).Row
            If logWs.Cells(i, 1).Value = idToFind Then 'Если ID совпадает
                foundRow = i 'Запоминаем номер строки
                Exit For 'Выходим из цикла
            End If
        Next i
 
        If foundRow > 0 Then 'Если запись с таким ID найдена в журнале
            'Определяем последнюю колонку с данными в этой строке
            lastColumn = logWs.Cells(foundRow, logWs.Columns.Count).End(xlToLeft).Column
 
            'Находим первую свободную колонку для записи информации о редактировании
            editCol = lastColumn + 1
 
            'Записываем имя пользователя, который редактировал данные
            logWs.Cells(foundRow, editCol).Value = Application.UserName
 
            'Записываем время редактирования в соседнюю ячейку
            logWs.Cells(foundRow, editCol + 1).Value = Now()
 
            'Применяем жирную границу к обеим ячейкам
            With logWs.Range(logWs.Cells(foundRow, editCol), logWs.Cells(foundRow, editCol + 1)).Borders
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End If
        MsgBox "Успешно отредактировано!", vbInformation
        LoadDataToForm
    Else 'Добавляем новую запись
        If Application.WorksheetFunction.CountA(ws.Columns("A")) > 1 Then
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            newID = ws.Cells(lastRow, 2).Value + 1
        Else
            newID = 1
        End If
 
        ws.Cells(lastRow + 1, 1).Value = txtSubscriberName.Text
        ws.Cells(lastRow + 1, 2).Value = newID
        ws.Cells(lastRow + 1, 3).Value = txtSubscriberNumber.Text
        ws.Cells(lastRow + 1, 4).Value = txtTariff.Text
        ws.Cells(lastRow + 1, 16).Value = cboProblem.Value
        ws.Cells(lastRow + 1, 7).Value = cboOwnerUser.Value
        ws.Cells(lastRow + 1, 8).Value = cboReasonLowRating.Value
        ws.Cells(lastRow + 1, 9).Value = cboConfirmation.Value
        ws.Cells(lastRow + 1, 10).Value = cboGender.Value
        ws.Cells(lastRow + 1, 11).Value = txtReasonDetails.Text
        ws.Cells(lastRow + 1, 12).Value = txtNextSteps.Text
        ws.Cells(lastRow + 1, 13).Value = txtMeasuresTaken.Text
        ws.Cells(lastRow + 1, 14).Value = txtBSNumber.Text
        ws.Cells(lastRow + 1, 15).Value = txtBSState.Text
        ws.Cells(lastRow + 1, 17).Value = cboArea.Value
        ws.Cells(lastRow + 1, 18).Value = txtRegion.Text
        ws.Cells(lastRow + 1, 19).Value = txtCommentsResults.Text
        ws.Cells(lastRow + 1, 20).Value = rating
        ws.Cells(lastRow + 1, 21).Value = cboStatus.Value
        ws.Cells(lastRow + 1, 22).Value = cboResult.Value
        ws.Cells(lastRow + 1, 24).Value = cboQuestionResolution.Value
        ws.Cells(lastRow + 1, 25).Value = txtSurveyConductedBy.Text 'Провёл опрос
        ws.Cells(lastRow + 1, 26).Value = txtTicketNumber.Text 'Номер заявки
        ws.Cells(lastRow + 1, 5).Value = assessmentDate
        ws.Cells(lastRow + 1, 6).Value = CDate(txtSurveyDate.Text)
        logRow = logWs.Cells(logWs.Rows.Count, "A").End(xlUp).Row + 1
 
        logWs.Cells(logRow, 1).Value = newID
        logWs.Cells(logRow, 2).Value = txtSurveyConductedBy.Text
        logWs.Cells(logRow, 3).Value = txtSubscriberNumber.Text
        logWs.Cells(logRow, 4).Value = txtSurveyDate.Text
        logWs.Cells(logRow, 5).Value = Now()
 
        currentRow = 0
    End If
 
    If currentRow = 0 Then
        ClearForm
        txtSurveyDate.Text = Format(Now(), "dd.mm.yyyy hh:mm:ss")
        txtSurveyConductedBy.Text = Application.UserName
        lblID.caption = "ID:"
    End If
 
    LoadDataToForm
    If currentRow = 0 Then
        LoadDataToForm
    End If
 
    MsgBox "Данные сохранены!", vbInformation
End Sub
 
Private Sub cmdNew_Click()
    Dim ws As Worksheet
    Set ws = GetDatabaseSheet()
 
    ClearForm
 
    txtSurveyDate.Text = Format(Now(), "dd.mm.yyyy hh:mm:ss")
    txtSurveyConductedBy.Text = Application.UserName
 
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    currentRow = 0
 
    LoadDataToForm
 
    lblID.caption = "ID:"
End Sub
 
Private Function GetDatabaseSheet() As Worksheet
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(DATABASE_SHEET_NAME)
    On Error GoTo 0
 
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add
        ws.name = DATABASE_SHEET_NAME
 
        With ws
            .Cells(1, 1).Value = "Имя абонента"
            .Cells(1, 2).Value = "ID"
            .Cells(1, 3).Value = "Номер абонента"
            .Cells(1, 4).Value = "Тариф"
            .Cells(1, 5).Value = "Дата оценки"
            .Cells(1, 6).Value = "Дата и время звонка"
            .Cells(1, 7).Value = "Владелец / Пользователь"
            .Cells(1, 8).Value = "Причина низкой оценки"
            .Cells(1, 9).Value = "Подтверждение"
            .Cells(1, 10).Value = "Пол"
            .Cells(1, 11).Value = "Причина недовольства (детали)"
            .Cells(1, 12).Value = "Следующие шаги"
            .Cells(1, 13).Value = "Принятые меры"
            .Cells(1, 14).Value = "Номер БС"
            .Cells(1, 15).Value = "Состояние БС"
            .Cells(1, 16).Value = "Проблема есть (1)/Нет (0)"
            .Cells(1, 17).Value = "Область"
            .Cells(1, 18).Value = "Район"
            .Cells(1, 19).Value = "Комментарии по итогам"
            .Cells(1, 20).Value = "Оценка по итогу опроса"
            .Cells(1, 21).Value = "Статус"
            .Cells(1, 22).Value = "Результат"
            .Cells(1, 23).Value = "СМС ответ - шаблон"
            .Cells(1, 24).Value = "Решение вопроса"
            .Cells(1, 25).Value = "ФИО проводившего"
            .Cells(1, 26).Value = "Заявка"
        End With
    End If
 
    Set GetDatabaseSheet = ws
End Function
 
Private Function GetLogSheet() As Worksheet
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(LOG_SHEET_NAME)
    On Error GoTo 0
 
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add
        ws.name = LOG_SHEET_NAME
 
        With ws
            .Cells(1, 1).Value = "ID"
            .Cells(1, 2).Value = "ФИО проводившего"
            .Cells(1, 3).Value = "Номер абонента"
            .Cells(1, 4).Value = "Дата и время звонка"
            .Cells(1, 5).Value = "Дата и время создания"
        End With
    End If
    Set GetLogSheet = ws
End Function
 
Private Sub Workbook_Open()
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(LOG_SHEET_NAME)
    On Error GoTo 0
    If Not ws Is Nothing Then
        ws.Visible = xlSheetHidden
    End If
End Sub