在多个工作表的同一列中查找值

在我的工作簿中的三张（面包房，花卉，杂货店）的B列中，我想要查找在B列中有单词“ Flyer行。每个工作表中将有多行在B列中包含单词“ Flyer当它findFlyer这个单词时，它会将整行粘贴到Sheet1中。

我去这个在一个选项卡上工作，但需要相同的代码来search所有三个选项卡（但不是全部五…这是问题），并粘贴到B列中单词Flyer所有行到Sheet1。

我的代码（工作，但只在面包店选项卡）：

 Sub CopyRowsFlyer() 'This looks in the Bakery tab and moves everything that has "Flyer" in column B to Sheet 1 Dim bottomB As Integer Dim x As Integer bottomB = Sheets("Bakery").Range("B" & Rows.Count).End(xlUp).Row: x = 1 Dim c As Range For Each c In Sheets("Bakery").Range("B3:B" & bottomB) If c.Value = "Flyer" Then c.EntireRow.Copy Worksheets("sheet1").Range("A" & x) x = x + 1 End If Next c End Sub 

Answer 1

与其他解决scheme类似。 很简单。 取代范围检查的边界。 最less的variables。 没有中等规模的执行。

 Sub CopyRowsFlyer() Dim strSh As Variant, c As Range, x As Integer x = 1 For Each strSh In Array("Bakery", "Floral", "Grocery") For Each c In Worksheets(strSh).Range("B:B") If c = "" and c.Row > 2 Then Exit For ElseIf c = "Flyer" and c.Row > 2 Then c.EntireRow.Copy Worksheets("Sheet1").Range("A" & x) x = x + 1 End If Next Next End Sub 

Answer 2

你只是想循环通过你想要的三张表。 尝试这个：

  Sub CopyRowsFlyer() 'This looks in the Bakery tab and moves everything that has "Flyer" in column B to Sheet 1 Dim bottomB As Integer Dim x As Integer Dim SheetsArray() As Variant Dim ws As WorkSheet Dim i As Integer SheetsArray = Array("Bakery", "Sheet2Name", "Sheet3Name") For i = LBound(SheetsArray) To UBound(SheetsArray) Set ws = Sheets(SheetsArray(i)) bottomB = ws.Range("B" & Rows.Count).End(xlUp).Row: x = 1 Dim c As Range For Each c In ws.Range("B3:B" & bottomB) If c.Value = "Flyer" Then c.EntireRow.Copy Worksheets("sheet1").Range("A" & x) x = x + 1 End If Next c Next i End Sub 

Answer 3

您可以用一个string数组的元素replace表格中的ID。

这里是你的代码修改，以反映。

 Sub CopyRowsFlyer() Dim bottomB As Integer Dim x As Integer Dim sheetName(1 to 3) As String, i as Integer sheetName(1) = "Bakery" sheetName(2) = "Floral" sheetName(3) = "Grocery" x=1 For i = 1 to 3 bottomB = Sheets(sheetName(i)).Range("B" & Rows.Count).End(xlUp).Row Dim c As Range For Each c In Sheets(sheetName(i)).Range("B3:B" & bottomB) If c.Value = "Flyer" Then c.EntireRow.Copy Worksheets("sheet1").Range("A" & x) x = x + 1 End If Next c Next i End Sub 

Answer 4

将所需的工作表名称存储在数组中并循环。

 Sub CopyRowsFlyer() Dim bottomB As Long, b As Long, x As Long Dim w As Long, vWSs As Variant vWSs = Array("Bakery", "Floral", "Grocery") x = 1 For w = LBound(vWSs) To UBound(vWSs) With Worksheets(vWSs(w)) bottomB = .Range("B" & Rows.Count).End(xlUp).Row For b = 3 To bottomB If LCase(.Cells(b, "B").Value) = "flyer" Then .Rows(b).EntireRow.Copy Worksheets("sheet1").Range("A" & x) x = x + 1 End If Next b End With Next w End Sub 

虽然循环遍历每个工作表的B列中的单元格的方法与其他方法（如.Range.Find方法）相比效率低下，但对较小的一组数据不会产生太大的影响。 如果每个工作表上有大量的行要检查，那么您可能希望探索其他更直接的检索信息的途径。