将特定列有条件地复制到另一个工作表

我有下面的例子将从工作表1复制到工作表2的特定行，如果在E列中find“是”。我需要它只复制行的特定列，是B＆C.

Fund Account Amount Gain/Loss As/Of? (Y/N) 1 11111 $15,000.00 -$1.51 YES 1 22222 $32,158.52 $78.14 YES 2 123123 $1.00 $0.00 NO 

码：

 Sub As_Of_Analysis_Sorting() Dim lr As Long, lr2 As Long, r As Long lr = Sheets("All Trades").Cells(Rows.Count, "A").End(xlUp).Row lr2 = Sheets("As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row For r = lr To 2 Step -1 If Range("E" & r).Value = "YES" Then Rows(r).Copy Destination:=Sheets("As-Of Trades").Range("A" & lr2 + 1) lr2 = Sheets("As-Of Trades").Cells(Rows.Count, "A").End(xlUp).Row End If Range("A1").Select Next r End Sub 

Answer 1

尝试这个：

 Sub As_Of_Analysis_Sorting() Dim lr As Long, lr2 As Long, r As Long Set Sh1 = ThisWorkbook.Worksheets("All Trades") Set Sh2 = ThisWorkbook.Worksheets("As-Of Trades") Sh1.Select Sh2.Cells(1, 1).Value = "Account" Sh2.Cells(1, 2).Value = "Amount" lr = Sh1.Cells(Rows.Count, "A").End(xlUp).row x = 2 For r = 2 To lr If Range("E" & r).Value = "YES" Then Sh2.Cells(x, 1).Value = Sh1.Cells(r, 2).Value Sh2.Cells(x, 2).Value = Sh1.Cells(r, 3).Value x = x + 1 End If Next r Sh2.Select End Sub 

---

新要求：

 Sub As_Of_Analysis_Sorting() Dim lr As Long, lr2 As Long, r As Long Set Sh1 = ThisWorkbook.Worksheets("All Trades") Set Sh2 = ThisWorkbook.Worksheets("As-Of Trades") Sh1.Select Sh2.Cells(1, 1).Value = "Account" Sh2.Cells(1, 2).Value = "Amount" lr = Sh1.Cells(Rows.Count, "A").End(xlUp).row x = 2 For r = 2 To 30 If Range("E" & r).Value = "YES" Then Sh2.Cells(x, 1).Value = Sh1.Cells(r, 2).Value Sh2.Cells(x, 2).Value = Sh1.Cells(r, 3).Value x = x + 1 End If Next r x = 35 For r = 31 To lr If Range("E" & r).Value = "YES" Then Sh2.Cells(x, 1).Value = Sh1.Cells(r, 2).Value Sh2.Cells(x, 2).Value = Sh1.Cells(r, 3).Value x = x + 1 End If Next r Sh2.Select End Sub 

Answer 2

你需要做的是做一个For一个计数器，将从上到下阅读表中的东西的所有单元格。 F是你想放置东西的新工作表的行。

尝试类似这样的事情：

 sub alfa() UF = Cells(Rows.Count, 1).End(xlUp).Row for i = 1 to uf if sheetname.cells(i,Columnofyes).value = "YES" then sheetwheretocopy.cells(f,columnwheretocopy).value = sheetname.cells(i,columnofdata).value f=f+1 end if next i end sub