excel - 根据数值从多个工作表中复制行

Question

我有多个销售工作表，销售人员在其中放置了他们对特定销售的信心水平。我刚刚开始学习 VBA，所以我不是一无所知，但我不得不承认这超出了我的想象。

如果一行的置信度超过 60%，我希望将整行复制到新工作表中。

数据从第 8 行开始，置信百分比列是 V 列。

我希望将 VBA 脚本应用于总共 9 个工作表，它们的名称为:

杰夫

约翰

蒂姆

皮特

乍得

鲍勃

凯文

迈克

账单

我希望将置信度超过 60% 的所有行复制到主表或“安装”表，从第 8 行再次开始。我想通过“安装”表上的按钮运行脚本。

这是我正在使用的图片:

Answer 1

下面的代码

将所有九张工作表中的第 8 行(如果名称存在)复制到名为“安装”的工作表

任何低于 60% 的记录都会自动过滤并从主工作表中删除(比在复制前自动过滤九张工作表中的每一个更有效)

在顶部添加空白行以在第 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