Question

我的代码效果很好。

除非列表中的其他工作表没有指定的工作表名称，否则它不执行任何操作。所以我想添加一个代码，弹出窗口说“工作簿上不存在工作表名称”。

我尽可能多地尝试了代码，但似乎没有任何代码可行。最后一个工作 BUT 它为该工作簿中的每个工作表都有一个弹出窗口，而不是我要查找的工作表。

如何编辑它，以便在单击时，代码将搜索其他工作簿，确定工作表是否在多个工作表中，并且只有1个弹出窗口表示它不是？

谢谢

Private Sub CopyPasteButton_Click()
    ActiveSheet.Unprotect Password:=PSWD
    Dim mySheet As Worksheet, otherSheet As Worksheet
    Dim ws As Worksheet

    On Error GoTo exit_err

    Application.DisplayAlerts = False

    Set mySheet = ThisWorkbook.Sheets("Info")


    For Each ws In Workbooks(Me.ListBox1.Value).Worksheets
    If ws.Name = "This is It" Then

        Set otherSheet = Workbooks(Me.ListBox1.Value).Sheets("This is It")

        If otherSheet.Range("AN1") >= 148 Then

            mySheet.Range("A50:J57").Copy
        otherSheet.Range("A5:J12").PasteSpecial xlPasteValuesAndNumberFormats

            mySheet.Range("M6:N6").Copy
        otherSheet.Range("Q19:R19").PasteSpecial xlPasteValuesAndNumberFormats

        Else
           MsgBox "Wrong Sheet Version"
        End If

        Else
           MsgBox "Sheet Does not Exist"
    End If
    Next ws

exit_err:
    mySheet.Protect Password:=PSWD
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub

Function WorksheetExists(ByValWorksheetName As String) As Boolean
Dim Sht As Worksheet

For Each Sht In Workbooks(Me.ListBox1.Value).Worksheets
If Application.Proper(Sht.Name) = Application.Proper(WorksheetName) Then
WorksheetExists = True
Exit Function
End If
Next Sht
WorksheetExists = False
End Function

Answer 1

不要在工作表中循环，只是尝试设置对工作表的引用并捕获错误，以防它不存在。

Private Sub CopyPasteButton_Click()
ActiveSheet.Unprotect Password:=pswd
Dim mySheet As Worksheet, otherSheet As Worksheet
Dim ws As Worksheet

On Error GoTo exit_err

Application.DisplayAlerts = False

Set mySheet = ThisWorkbook.Sheets("Info")

On Error Resume Next
Set otherSheet = Workbooks(Me.ListBox1.Value).Worksheets("This is It")
On Error GoTo 0
If Not otherSheet Is Nothing Then

    If otherSheet.Range("AN1") >= 148 Then

        mySheet.Range("A50:J57").Copy
        otherSheet.Range("A5:J12").PasteSpecial xlPasteValuesAndNumberFormats

        mySheet.Range("M6:N6").Copy
        otherSheet.Range("Q19:R19").PasteSpecial xlPasteValuesAndNumberFormats

    Else
       MsgBox "Wrong Sheet Version"
    End If

Else
   MsgBox "Sheet Does not Exist"
End If

exit_err:
    mySheet.Protect Password:=pswd
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub

在进行之前，请检查其他工作簿中的工作表名称

1 个答案: