我在excel工作簿中有多张工作表。我需要扫描所有这些表在点击一个按钮，并从表中选择特定的值

我在单独的表格中有以下表格（但工作簿相同）：

第1页

第2页

第3页

在第4页中，我需要单击按钮。此按钮将扫描表1、2和3，并提供永久栏值为“否”的项目列表。它必须是第4页中的一个列表

预期第4页：

我不知道从哪里开始。

您可以尝试：

Option Explicit

Sub test()

    Dim ws As Worksheet
    Dim LastrowWS As Long, LastrowS4 As Long, i As Long

    For Each ws In ThisWorkbook.Worksheets

        If ws.name <> "Sheet4" Then

            With ws

                LastrowWS = .Cells(.Rows.Count, "A").End(xlUp).Row

                For i = 2 To LastrowWS

                    If .Range("C" & i).Value = "No" Then

                        .Range("A" & i & ":C" & i).Copy

                        With ThisWorkbook.Worksheets("Sheet4")

                            LastrowS4 = .Cells(.Rows.Count, "A").End(xlUp).Row

                            .Range("A" & LastrowS4 + 1).PasteSpecial xlPasteValues

                        End With

                    End If

                Next i

            End With

        End If

    Next

End Sub

选项显式
子测试（）
将ws设置为工作表
暗淡的最后一行尽可能长，最后一行尽可能长，我尽可能长
对于此工作簿中的每个ws。工作表
如果ws.name“Sheet4”，则
与ws
LastrowWS=.Cells（.Rows.Count，“A”）.End（xlUp）.Row
对于i=2到LastrowWS
如果.Range（“C”&i）.Value=“否”，则
.Range（“A”&i&“：C”&i）。复制
使用此工作簿。工作表（“表4”）
LastrowS4=.Cells（.Rows.Count，“A”）.End（xlUp）.Row
.Range（“A”&最后一行4+1）.粘贴特殊XLPaste值
以
如果结束
接下来我
以
如果结束
下一个
端接头

这远远不是一个完美的解决方案，它仍然需要一些错误处理来满足日常问题。。。但是，它应该为您提供一个很好的起点，让您知道如何操作数据，并且这样做时无需多次从电子表格中来回读取数据（尽管对于几行来说这并不重要，但对于少数几行来说这并不重要）

选项显式
Sub-getNonPermanents（）
将wb设置为工作簿：设置wb=ActiveWorkbook'或ThisWorkbook，或设置保存数据的工作簿的名称
将ws设置为工作表
变暗R为长，C为长，X为长
暗淡的光线和长的一样
弱ARR数据
Dim arrNonPerm（）作为字符串：ReDim arrNonPerm（1到3，1到1）
对于wb.Worksheets（）中的每个ws
如果ws.Name=“Sheet1”或ws.Name=“Sheet2”或ws.Name=“Sheet3”那么“或”可能只是ws.Name“sheet4”，和/或其他更优雅的处理方法
lRow=ws.Cells（ws.Rows.Count，1）.End（xlUp）.row'获取当前工作表中的最后一行
arrData=ws.Range（ws.Cells（2，1），ws.Cells（lRow，3））'将所有数据分配给一个数组
对于R=LBound（arrData）到UBound（arrData），循环遍历数据，如果有，则为“否”。。。。
如果arrData（R，3）=“否”，则
X=X+1
ReDim Preserve arrNonPerm（1到3，1到X）'根据需要增加数组
对于C=LBound（arrData，2）到UBound（arrData，2）
arrNonPerm（C，X）=arrData（R，C）'分配给非perm数组
下一个C
如果结束
下一个R
如果结束
下一个ws
删除ARR数据
ReDim arrData（LBound（arrNonPerm，2）到UBound（arrNonPerm，2），LBound（arrNonPerm）到UBound（arrNonPerm））
对于R=LBound（arrNonPerm，2）到UBound（arrNonPerm，2）'将数据重新分配到一个数组，以便将其放回工作表中
对于C=LBound（arrNonPerm）到UBound（arrNonPerm）
arrData（C，R）=arrNonPerm（R，C）
下一个C
下一个R
带wb.工作表（“表4”）
lRow=.Cells（.Rows.Count，1）.End（xlUp）.row
.Range（.Cells（lRow+1,1），.Cells（lRow+UBound（arrData），3））=arrData'将数据添加到现有数据的末尾（即，最短的标题）。
以
端接头

您能否列出您尝试过的内容和未按预期工作的内容？此外，还标记了VBA和Excel公式。你在做哪一个？单击按钮意味着您查看VBA而不是公式。将所有数据从sheet1复制到sheet3到sheet4，并在sheet4中使用AutoFilter请注意，因为这不是免费的代码编写服务，所以有必要显示您迄今为止所做的尝试以及您遇到的问题或错误（通过显示代码），或者至少显示您所做的研究和努力。否则它只是要求我们为你做所有的工作。阅读可能会帮助你改进你的问题。请参阅和。还可以在Simple和doing what required上查看更多的好信息。。。当然，它也适用于几行。但是，如果有数千行，数据越大，速度就越慢。理想情况下，您应该只使用VBA访问工作表两次，读/写，并使用数组处理背景中的所有内容（以光速）。@DarXyde每个答案都应该提供一种方法，可以到达您想要的地方。不是这样的，尤其是当OP在没有提供任何努力的情况下请求代码时。如果你需要速度，你应该把字典当作最好的解决方案。

Option Explicit

Sub getNonPermanents()

Dim wb As Workbook: Set wb = ActiveWorkbook         'or ThisWorkbook, or the name of the workbook where data is
Dim ws As Worksheet
Dim R As Long, C As Long, X As Long
Dim lRow As Long

Dim arrData
Dim arrNonPerm() As String: ReDim arrNonPerm(1 To 3, 1 To 1)

    For Each ws In wb.Worksheets()
        If ws.Name = "Sheet1" Or ws.Name = "Sheet2" Or ws.Name = "Sheet3" Then  'Or could just be ws.Name <> "Sheet 4", and/or other more elegant ways to deal with this
            lRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row                     'Get the last row in the current sheet

            arrData = ws.Range(ws.Cells(2, 1), ws.Cells(lRow, 3))               'Allocate all data to an array

            For R = LBound(arrData) To UBound(arrData)                          'Loop through the data, and if any are "No"....
                If arrData(R, 3) = "No" Then
                    X = X + 1
                    ReDim Preserve arrNonPerm(1 To 3, 1 To X)                   'Increase the array as needed
                    For C = LBound(arrData, 2) To UBound(arrData, 2)
                        arrNonPerm(C, X) = arrData(R, C)                        'Allocate to the non perm array
                    Next C
                End If
            Next R
        End If
    Next ws

    Erase arrData
    ReDim arrData(LBound(arrNonPerm, 2) To UBound(arrNonPerm, 2), LBound(arrNonPerm) To UBound(arrNonPerm))

    For R = LBound(arrNonPerm, 2) To UBound(arrNonPerm, 2)                      'Reallocate the data to an array to be ready to put it back in the sheet
        For C = LBound(arrNonPerm) To UBound(arrNonPerm)
            arrData(C, R) = arrNonPerm(R, C)
        Next C
    Next R

    With wb.Worksheets("Sheet4")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).row
        .Range(.Cells(lRow + 1, 1), .Cells(lRow + UBound(arrData), 3)) = arrData    'Add the data at the end of existing data (i.e. headers the very least).
    End With

End Sub