在复制行时存在error handling

跟着我的post如果单元格的值匹配UserForm ComboBox列，然后复制到工作表 。

我设法让代码工作，移动检查名称，然后移动到正确的工作表。

我遇到的问题是检查表单是否存在。 如果在combobox的表格和列2中find匹配项，但没有该值的表单，则会崩溃代码。

2. 一旦所有的信息被复制到相关的工作表，我希望它显示一个msgbox告诉用户有多less行数据已被复制到相应的工作表。

   Dim i As Long, j As Long, lastG As Long, strWS As String, rngCPY As Range With Application .ScreenUpdating = False .EnableEvents = False .CutCopyMode = False End With On Error GoTo bm_Close_Out ' find last row lastG = sheets("Global").Cells(Rows.Count, "Q").End(xlUp).row For i = 3 To lastG lookupVal = sheets("Global").Cells(i, "Q") ' value to find ' loop over values in "details" For j = 0 To Me.ComboBox2.ListCount - 1 currVal = Me.ComboBox2.List(j, 2) ' value to match If lookupVal = currVal Then Set rngCPY = sheets("Global").Cells(i, "Q").EntireRow strWS = Me.ComboBox2.List(j, 1) On Error GoTo bm_Need_Worksheet '<~~ if the worksheet in the next line does not exist, go make one With Worksheets(strWS) rngCPY.Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown End With End If Next j Next i GoTo bm_Close_Out bm_Need_Worksheet: On Error GoTo 0 With Worksheet Dim wb As Workbook: Set wb = ThisWorkbook Dim wsTemplate As Worksheet: Set wsTemplate = wb.sheets("Template") Dim wsPayment As Worksheet: Set wsPayment = wb.sheets("Payment Form") Dim wsNew As Worksheet Dim lastRow2 As Long Dim Contract As String: Contract = sheets("Payment Form").Range("C9").value Dim SpacePos As Integer: SpacePos = InStr(Contract, "- ") Dim Name As String: Name = Left(Contract, SpacePos) Dim Name2 As String: Name2 = Right(Contract, Len(Contract) - Len(Name)) Dim NewName As String: NewName = strWS Dim CCName As Variant: CCName = Me.ComboBox2.List(j, 0) Dim lastRow As Long: lastRow = wsPayment.Range("U36:U53").End(xlDown).row If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then lastRow2 = wsPayment.Range("A23:A39").End(xlDown).row Else lastRow2 = wsPayment.Range("A18:A34").End(xlDown).row End If wsTemplate.Visible = True wsTemplate.Copy before:=sheets("Details"): Set wsNew = ActiveSheet wsTemplate.Visible = False If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then With wsPayment For Each cell In .Range("A23:A39") If Len(cell) = 0 Then If sheets("Payment Form").Range("A20").value = "Network" Then cell.value = NewName & " - " & Name2 & ": " & CCName Else cell.value = NewName & " - " & Name2 & ": " & CCName End If Exit For End If Next cell End With Else With wsPayment For Each cell In .Range("A18:A34") If Len(cell) = 0 Then If sheets("Payment Form").Range("A20").value = "Network" Then cell.value = NewName & " - " & Name2 & ": " & CCName Else cell.value = NewName & " - " & Name2 & ": " & CCName End If Exit For End If Next cell End With End If If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then With wsNew .Name = NewName .Range("D4").value = wsPayment.Range("A23:A39").End(xlDown).value .Range("D6").value = wsPayment.Range("L11").value .Range("D8").value = wsPayment.Range("C9").value .Range("D10").value = wsPayment.Range("C11").value End With Else With wsNew .Name = NewName .Range("D4").value = wsPayment.Range("A18:A34").End(xlDown).value .Range("D6").value = wsPayment.Range("L11").value .Range("D8").value = wsPayment.Range("C9").value .Range("D10").value = wsPayment.Range("C11").value End With End If wsPayment.Activate With wsPayment .Range("J" & lastRow2 + 1).value = 0 .Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & "" .Range("N" & lastRow2 + 1).Formula = "='" & NewName & "'!L20" .Range("U" & lastRow + 1).value = NewName & ": " .Range("V" & lastRow + 1).Formula = "='" & NewName & "'!I21" .Range("W" & lastRow + 1).Formula = "='" & NewName & "'!I23" .Range("X" & lastRow + 1).Formula = "='" & NewName & "'!K21" End With End With On Error GoTo bm_Close_Out Resume bm_Close_Out: With Application .ScreenUpdating = True .EnableEvents = True .CutCopyMode = True End With 

在Jeeped的帮助下，我已经设法获得将行复制到相关工作表的代码，并且如果工作表不存在，就创build它。 我只需要帮助上面的问题二。

Answer 1

尝试使用不存在的工作表对象会引发错误。 如果您发现该错误并使用您正在查找的名称创build工作表，则可以Resume到抛出错误的位置并继续处理。

 Private Sub CommandButton7_Click() Dim i As Long, j As Long, lastG As Long, strWS As String, strMSG As String dim rngHDR as range, rngCPY aS range With Application .ScreenUpdating = False .EnableEvents = False .CutCopyMode = False End With On Error GoTo bm_Close_Out ' find last row lastG = Sheets("Global").Cells(Rows.Count, "Q").End(xlUp).Row For i = 3 To lastG lookupVal = Sheets("Global").Cells(i, "Q") ' value to find ' loop over values in "details" For j = 0 To Me.ComboBox2.ListCount - 1 currVal = Me.ComboBox2.List(j, 2) ' value to match If lookupVal = currVal Then set rngHDR = Sheets("Global").Cells(1, "Q").EntireRow set rngCPY = Sheets("Global").Cells(i, "Q").EntireRow strWS = Me.ComboBox2.List(j, 1) On Error GoTo bm_Need_Worksheet '<~~ if the worksheet in the next line does not exist, go make one With WorkSheets(strWS) rngCPY .copy .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown End With exit for End If Next j if j >= Me.ComboBox2.ListCount then _ strMSG = strMSG & "Not found: " & lookupVal & chr(10) Next i GoTo bm_Close_Out bm_Need_Worksheet: On Error GoTo 0 With Worksheets.Add(after:=Sheets(Sheets.Count)) .Name = strWS 'maybe make a header row here; watch out you do not lose your copy rngHDR.copy destination:=.cells(1, 1) End With On Error GoTo bm_Close_Out Resume bm_Close_Out: With Application .ScreenUpdating = True .EnableEvents = True .CutCopyMode = False End With debug.print strMSG 'the next is NOT recommended as strMSG could possibly be VERY long 'if cbool(len(strMSG)) then msgbox strMSG End Sub 

有一个关于新工作表是否需要列标题行的问题，但应该相当容易地纠正。

Answer 2

你可以使用这样的function：

 Sub test_atame() Dim Ws As Worksheet Set Ws = Sheet_Exists(ThisWorkbook, "Sheet1") Set Ws = Sheet_Exists(ActiveWorkbook, "Sheet1") End Sub 

这是function：

 Public Function Sheet_Exists(aWorkBook As Workbook, Sheet_Name As String) As Worksheet Dim Ws As Worksheet, _ SExistS As Boolean SExistS = False For Each Ws In aWorkBook.Sheets If Ws.Name <> Sheet_Name Then Else SExistS = True Exit For End If Next Ws If SExistS Then Set Sheet_Exists = aWorkBook.Sheets(Sheet_Name) Else Set Sheet_Exists = Nothing MsgBox "The sheet " & Sheet_Name & " wasn't found in " & aWorkBook.Name & vbCrLf & _ "Break code to check and correct.", vbCritical + vbOKOnly End If End Function 

Answer 3

也许这样的检查：

 Public Function SheetExists(ByVal Book As Workbook, ByVal SheetName As String) As Boolean On Error Resume Next Dim wsTest As Worksheet Set wsTest = Book.Worksheets(SheetName) If Not wsTest Is Nothing Then SheetExists = True End Function