循環遍歷列表，將值與閾值進行比較並複製並粘貼相應的值

Question

我有一份工作表數據，其中包含與這些公司對應的公司和百分比列表。在工作表儀表板上，我有一個閾值（比如20％）

我想查看每個公司的百分比，如果百分比低於閾值（20％），那麼我想將該公司複製到下一個可用工作表儀表板上的B列中的行。

我到目前爲止的代碼是：

Sub companydraw() 

Set wsDest = Sheets("Dashboard") 
Set wsData = Sheets("Data") 


wsDest.Columns("B").Rows(7 & ":" & wsDest.Rows.Count).ClearContents 

lr = wsData.UsedRange.Rows.Count 

Dim rRng As Range 

Set rRng = wsData.Range("W5: W418") 

For Each i In rRng 

If i.Value > wsDest.Range("F2").Value Then 

    wsData.Range("N5:N" & lr).Copy wsDest.Range("B" & Rows.Count).End(3)(2) 

End If 
Next i 

End Sub 

我的代碼的帖子上一個迭代，因爲它沒有考慮到所有公司的所有百分比這是不正確的所有企業，它當時的提示我保存我不瞭解的電子表格。

如果有人能幫助這將是驚人的

Answer 1

在你的腳本看你想從數據表中查詢列W上的值對值F2在目標表，然後從列複製值N在下一個可用行的目標工作表中相應行中的列B中的數據表中。

這應做到：

Sub companydraw() 
Dim wsDest As Worksheet 
Dim wsData As Worksheet 
Dim i As Integer 
Dim lastrow As Integer 
Dim writerow As Integer 

Set wsDest = Worksheets("Dashboard") 
Set wsData = Worksheets("Data") 

writerow = wsDest.Range("B65536").End(xlUp).Row + 1 
lastrow = wsData.UsedRange.Rows.Count 

For i = 2 To lastrow 
    If wsData.Range("W" & i).value < wsDest.Range("F2").value Then 'F2 holds the threshold value 
     wsDest.Range("B" & writerow).value = wsData.Range("N" & i).value 
     writerow = writerow + 1 
    End If 
Next i 

Set wsData = Nothing 
Set wsDest = Nothing 
End Sub