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

[Абдусамат]

Нужна помощь.
При пользовании формой заполнения, нет возможности пользоваться самим Excel фалом.
Копировать данные из листа Excel либо переходить на другие листы и в другие книги Excel и от туда копировать данные и вставлять в форму.

Код VBA

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

[свернуть]

[Администратор]

Не понятно задание.
Перефразируйте вопрос.

[Абдусамат]

При открытии формы заполнения нет возможности переходить в другие Листы в Excel либо копировать данные из ячеек в Excel чтобы вставить в форму заполнение. Можно это как то исправить?

[Администратор]

Кода много, нет возможности изучать весь код.
Вообще, чтобы форма (UserForm) не блокировала просмотр листов книги, нужно во время запуска формы, у формы сделать False.

На вашем скриншоте на листе есть кнопка "Заполнить форму", эта кнопка запускает какую-то процедуру, в которой есть команда для запуска формы, нужно после Show указать False:

Sub Macro()
    UserForm1.Show False
End Sub