根据数值复制多个工作表中的行
我有一个销售人员放在其他东西，其中一些销售的信心水平多个销售工作表。 我刚刚开始学习VBA，所以我不是一无所知，但我不得不承认这是在我的头上。
如果一行的置信度超过60％，我希望整个行被复制到一个新的工作表中。
数据从第8行开始，置信度百分比列为第V列。
总共有9个工作表，我想要应用VBA脚本，它们被命名为：
- 杰夫
- 约翰
- 蒂姆
- 皮特
- 乍得
- 短发
- 凯文
- 麦克风
- 法案
我希望将置信水平超过60％的所有行复制到主或“安装”表中，再次从第8行开始。我想通过“安装”工作表上的button运行脚本。
这里是我正在使用的图片：
下面的代码
- 将所有九张纸张（如果存在名称）中的第8行复制到名为“安装”
- 任何小于60％的logging都将被自动筛选并从主表单中删除（比复制之前对9个表单中的每一个进行自动过滤效率更高）
- 在顶部添加空白行以在第8行开始“安装”
*如果你确实需要从第1行到第7行的标题行，那么这些行可以从其中一个推销员表复制 – 让我知道*
Sub QuickCombine() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim rng1 As Range Dim strShts() Dim strWs As Variant Dim lngCalc As Long With Application .ScreenUpdating = False lngCalc = .Calculation .Calculation = xlCalculationManual End With Set ws1 = Sheets("Install") ws1.UsedRange.Cells.Clear strShts = Array("Jeff", "John", "Tim", "Pete", "Chad", "Bob", "Kevin", "Mike", "Bill") For Each strWs In strShts On Error Resume Next Set ws2 = Sheets(strWs) On Error GoTo 0 If Not ws2 Is Nothing Then Set rng1 = ws2.Range(ws2.[v8], ws2.Cells(Rows.Count, "v").End(xlUp)) rng1.EntireRow.Copy ws1.Cells(ws1.Cells(Rows.Count, "v").End(xlUp).Offset(1, 0).Row, "A") End If Set ws2 = Nothing Next With ws1 .[v1] = "dummy" .Columns("V").AutoFilter Field:=1, Criteria1:="<60%" .Rows.Delete .Rows("1:7").Insert End With With Application .ScreenUpdating = True .Calculation = lngCalc End With End Sub