Msgbox将行数复制到哪张表中

在这里有许多有帮助的人的帮助下，我已经到了代码完成我所需要的事情的地步！

我真的很苦恼MsgBox在最后显示有多less行已被复制到每张工作表。 如果在同一个MsgBox有全局工作表的任何不匹配，我也想要显示它。 如果没有find不匹配的部分，则可以省略该部分。

下面是代码，我已经search工作表column Q的值，并findUserForm上的ComboBox2的匹配。 这告诉哪些表格行需要被复制，并且如果需要新的表格，那么也要命名它以及一些其他需要的信息。

 Private Sub CommandButton1_Click() Dim i As Long, j As Long, k As Long, strWS As String, rngCPY As Range Dim noFind As Variant: noFind = UserForm2.ComboBox2.List '<~~~ get missed items With Application: .ScreenUpdating = False: .EnableEvents = False: .CutCopyMode = False: End With If Range("L9") = "" Then: MsgBox "You can't Split the Jobs at this stage. " & vbLf & vbLf & "Please create the form for the Sub-Contractor First." & vbLf & vbLf & "Please press Display Utilities to create form.", vbExclamation, "Invalid Operation": Exit Sub Dim lastG As Long: lastG = sheets("Global").Cells(Rows.Count, 17).End(xlUp).row Dim cVat As Boolean: cVat = InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") If sheets("PAYMENT FORM").Cells(35 - cVat * 5, 12) >= 1 Then: MsgBox "It appears you have already split the jobs, this operation can only be performed once.", vbExclamation, "Invalid Operation": Exit Sub For j = 0 To UserForm2.ComboBox2.ListCount - 1 noFind(j, 4) = 0 For i = 3 To lastG If noFind(j, 0) = sheets("Global").Cells(i, 17) Then k = i strWS = UserForm2.ComboBox2.List(j, 1) On Error Resume Next '<~~ if the worksheet in the next line does not exist, go make one If Len(Worksheets(strWS).Name) = 0 Then With ThisWorkbook On Error GoTo 0 Dim nStr As String: With sheets("Payment Form").Range("C9"): nStr = Right(.value, Len(.value) - Len(Left(.value, InStr(.value, "- ")))): End With Dim CCName As Variant: CCName = UserForm2.ComboBox2.List(j, 2) Dim lastRow As Long: lastRow = sheets("Payment Form").Range("U36:U53").End(xlDown).row Dim strRng As String: strRng = Array("A18:A34", "A23:A39")(-1 * cVat) Dim lastRow2 As Long: lastRow2 = sheets("Payment Form").Range(strRng).End(xlDown).row Dim wsTemplate As Worksheet: Set wsTemplate = ThisWorkbook.sheets("Template") Dim wsNew As Worksheet With sheets("Payment Form") For Each cell In .Range(strRng) If Len(cell) = 0 Then If sheets("Payment Form").Range("C9").value = "Network" Then cell.Offset.value = strWS & " - " & nStr & ": " & CCName Else cell.Offset.value = strWS & " -" & nStr & ": " & CCName End If Exit For End If Next cell End With With wsNew wsTemplate.Visible = True wsTemplate.Copy before:=sheets("Details"): Set wsNew = ActiveSheet wsTemplate.Visible = False wsNew.Name = strWS wsNew.Range("D4").value = sheets("Payment Form").Range(strRng).End(xlDown).value wsNew.Range("D6").value = sheets("Payment Form").Range("L11").value wsNew.Range("D8").value = sheets("Payment Form").Range("C9").value wsNew.Range("D10").value = sheets("Payment Form").Range("C11").value End With With .sheets("Payment Form") .Activate .Range("J" & lastRow2 + 1).value = 0 .Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & "" .Range("N" & lastRow2 + 1).Formula = "='" & strWS & "'!L20" .Range("U" & lastRow + 1).value = strWS & ": " .Range("V" & lastRow + 1).Formula = "='" & strWS & "'!I21" .Range("W" & lastRow + 1).Formula = "='" & strWS & "'!I23" .Range("X" & lastRow + 1).Formula = "='" & strWS & "'!K21" End With End With End If '<~~~ end new sheet On Error GoTo 0 While sheets("Global").Cells(k + 1, 17).value = noFind(j, 0) And k < lastG k = k + 1 Wend Set rngCPY = sheets("Global").Range("Q" & i & ":Q" & k).EntireRow With Worksheets(strWS) rngCPY.Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown End With noFind(j, 4) = noFind(j, 4) + k - i + 1 i = k End If Next i Next j With Application: .ScreenUpdating = True: .EnableEvents = True: .CutCopyMode = True: End With 'noFind(x, y) > x = item / y: 0 = name / y: 4 = counter noFind(0, 0) = noFind(0, 0) & " " & noFind(0, 4) & " times copied" For i = 1 To UBound(noFind) noFind(0, 0) = noFind(0, 0) & vbLf & noFind(i, 0) & " " & noFind(i, 4) & " times copied" Next MsgBox noFind(0, 0) End Sub 

这是MsgBox当前显示的内容：

这是我希望MsgBox显示的信息：

我希望它显示表名称，然后有多less行被复制到它。

在那下面复制的总行数。

然后，如果需要，在全局表单中find显示错误以及您find该值的次数。 即（BRERRORS）< – 这是单元格的值。

如果可能的话，也可能是在表单上find的错误总数。

在最底层，在全局表中search到的总行数将被用于比较，所以如果复制的行总数与全局表的总数不匹配，那么用户将知道他们需要在检查行值后手动复制一些行。

如果这有帮助的话，那就是没有MsgBox代码的原始代码，如果你能想到一个更好的方法来做到这一点。

 Private Sub btnSplitJobs_Click() Dim i As Long, j As Long, k As Long, strWS As String, rngCPY As Range With Application: .ScreenUpdating = False: .EnableEvents = False: .CutCopyMode = False: End With If Range("L9") = "" Then: MsgBox "You can't Split the Jobs at this stage. " & vbLf & vbLf & "Please create the form for the Sub-Contractor First." & vbLf & vbLf & "Please press Display Utilities to create form.", vbExclamation, "Invalid Operation": Exit Sub Dim lastG As Long: lastG = sheets("Global").Cells(Rows.Count, "Q").End(xlUp).row Dim cVat As Boolean: cVat = InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") If sheets("PAYMENT FORM").Cells(35 - cVat * 5, 12) >= 1 Then: MsgBox "It appears you have already split the jobs, this operation can only be performed once.", vbExclamation, "Invalid Operation": Exit Sub For j = 0 To UserForm2.ComboBox2.ListCount - 1 currval = UserForm2.ComboBox2.List(j, 0) For i = 3 To lastG If currval = sheets("Global").Cells(i, "Q") Then k = i strWS = UserForm2.ComboBox2.List(j, 1) On Error Resume Next '<~~ if the worksheet in the next line does not exist, go make one If Len(Worksheets(strWS).Name) = 0 Then With ThisWorkbook On Error GoTo 0 Dim nStr As String: With sheets("Payment Form").Range("C9"): nStr = Right(.value, Len(.value) - Len(Left(.value, InStr(.value, "- ")))): End With Dim CCName As Variant: CCName = UserForm2.ComboBox2.List(j, 2) Dim lastRow As Long: lastRow = sheets("Payment Form").Range("U36:U53").End(xlDown).row Dim strRng As String: strRng = Array("A18:A34", "A23:A39")(-1 * cVat) Dim lastRow2 As Long: lastRow2 = sheets("Payment Form").Range(strRng).End(xlDown).row Dim wsTemplate As Worksheet: Set wsTemplate = ThisWorkbook.sheets("Template") Dim wsNew As Worksheet With sheets("Payment Form") For Each cell In .Range(strRng) If Len(cell) = 0 Then If sheets("Payment Form").Range("C9").value = "Network" Then cell.Offset.value = strWS & " - " & nStr & ": " & CCName Else cell.Offset.value = strWS & " -" & nStr & ": " & CCName End If Exit For End If Next cell End With With wsNew wsTemplate.Visible = True wsTemplate.Copy before:=sheets("Details"): Set wsNew = ActiveSheet wsTemplate.Visible = False wsNew.Name = strWS wsNew.Range("D4").value = sheets("Payment Form").Range(strRng).End(xlDown).value wsNew.Range("D6").value = sheets("Payment Form").Range("L11").value wsNew.Range("D8").value = sheets("Payment Form").Range("C9").value wsNew.Range("D10").value = sheets("Payment Form").Range("C11").value End With With .sheets("Payment Form") .Activate .Range("J" & lastRow2 + 1).value = 0 .Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & "" .Range("N" & lastRow2 + 1).Formula = "='" & strWS & "'!L20" .Range("U" & lastRow + 1).value = strWS & ": " .Range("V" & lastRow + 1).Formula = "='" & strWS & "'!I21" .Range("W" & lastRow + 1).Formula = "='" & strWS & "'!I23" .Range("X" & lastRow + 1).Formula = "='" & strWS & "'!K21" End With End With End If '<~~~ end new sheet While sheets("Global").Cells(k + 1, 17).value = currval And k < lastG k = k + 1 Wend Set rngCPY = sheets("Global").Range("Q" & i & ":Q" & k).EntireRow With Worksheets(strWS) rngCPY.Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown End With i = k End If Next i Next j With Application: .ScreenUpdating = True: .EnableEvents = True: .CutCopyMode = True: End With End Sub