Требуется объект в Excel VBA - PullRequest
0 голосов
/ 03 июля 2019

Я пытаюсь заставить пользователя ввести имя листа, и на основе введенных данных я хочу, чтобы выбранное значение ячейки было скопировано с одного листа на другой лист в новую строку.

Это для базового Excelфункционирующая система

Set nextCellInColumn = Worksheets("Summary").Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)
strName = Application.InputBox("Please enter")
nextCellInColumn.Value = Worksheets.Application.InputBox("Please enter").Range("I5").Value
Worksheets.Application.InputBox("Please enter").Range("I5").Copy Worksheets("Summary").Range("D6")

1 Ответ

0 голосов
/ 03 июля 2019

Необходимо проверить, существует ли имя рабочего листа, введенное пользователем, в противном случае копирование не удастся. Также, если пользователь нажимает кнопку Cancel , InputBox возвращает логическое значение False. Вы должны проверить это и, например, выйти, или ваш код тоже не работает.

Option Explicit

Public Sub Test()
    Dim wsSummary As Worksheet
    Set wsSummary = ThisWorkbook.Worksheets("Summary")

    Dim NextCellInColumn As Range
    Set NextCellInColumn = wsSummary.Cells(wsSummary.Rows.Count, 4).End(xlUp).Offset(1, 0)

    Dim strName As Variant 'if user presses cancel it will return a boolean false
    strName = Application.InputBox("Please enter")

    If VarType(strName) = vbBoolean And strName = False Then Exit Sub 'user pressed cancel so exit

    If WorksheetExists(strName) Then
        NextCellInColumn.Value = ThisWorkbook.Worksheets(strName).Range("I5").Value
        ThisWorkbook.Worksheets(strName).Range("I5").Copy wsSummary.Range("D6")
    Else
        MsgBox "Worksheet '" & strName & "' not found.", vbCritical
    End If
End Sub

'check if a worksheet exists
Public Function WorksheetExists(ByVal WorksheetName As String, Optional ByVal wb As Workbook) As Boolean
    If wb Is Nothing Then Set wb = ThisWorkbook 'default to thisworkbook

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = wb.Worksheets(WorksheetName)
    On Error GoTo 0

    WorksheetExists = Not ws Is Nothing
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...