Необходимо проверить, существует ли имя рабочего листа, введенное пользователем, в противном случае копирование не удастся. Также, если пользователь нажимает кнопку 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