基於數值

Question

多個工作表複製行我有一個多層次的銷售工作表放在哪裏推銷員除其他事項外，他們的信心水平爲一定的銷售市場。我剛開始學習VBA，所以我不是一無所知，但我不得不承認這已經超出了我的想象。

如果行有超過60％的置信水平，我想整個行復制到一個新的工作表。

的數據在8行開始和信心百分比列爲列五

共有9個工作表我想VBA腳本被應用到，它們被命名爲：

• 傑夫
• 約翰
• 添
• 皮特
• 乍得
• 鮑勃
• 凱文
• 邁克
• 比爾

我想所有的置信水平上覆制到主機或60％的行「安裝」紙在8行再次開始。我想通過「安裝」工作表上的按鈕來運行腳本。

以下是我與工作的圖片：

Answer 1

下面

• 副本行8從你的所有9張（如果該名稱存在的話）向下代碼片被稱爲「安裝」
• 任何記錄小於60％的autofiltered和從主片（不是複製之前自動篩選各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