Vba 需要将多个excel工作表中的数据汇总到一个汇总页面上

我正试图为我们的一些转会做一个年度总结。基本上，我有12张工作表，一年中每个月一张，每个条目在第L列中给出了四个具体的转移理由中的一个。我需要能够创建一个工作表，根据每个转移理由为我提供一个连续的年度至今总结

比如说，我正在查看的转移理由被称为分配不正确-我认为需要让摘要页面显示每行的G-K列，其中L列在所有12个月工作表中分配不正确

我一直在看VBA代码，并试图调整一些工作，但我可以使用一些帮助

编辑：

很明显，它没有按我需要的那样工作，或者我不会在这里，但我对VBA不太了解。我这里有一些东西，代码获取了L列符合条件的条目，但它是

a复制所有列，我只需要G-K来粘贴

b将复制的行全部放在summary选项卡中的一行中，这样我可以在一瞬间看到数据，然后用下一行覆盖数据，依此类推，直到最后找到的条目确定下来

第二次编辑：

所以我有一个代码，现在大部分工作，我把它贴在下面，删除了上面的旧代码

Private Sub CommandButton1_Click()
    Dim WkSht As Worksheet
     Dim r As Integer
     Dim i As Integer
     i = 1
     For Each WkSht In ThisWorkbook.Worksheets
      i = i + 1
             If WkSht.Name <> "Incorrectly Assigned" Then
                     For r = 1 To 1000

                     If WkSht.Range("L" & r).Value = Sheets("Incorrectly Assigned").Range("A1").Value Then
                             WkSht.Range("E:L").Rows(r & ":" & r).Copy
                             Sheets("Incorrectly Assigned").Range("E:L").End(xlUp).Offset(i, 0).PasteSpecial Paste:=xlPasteValues
                     End If
                     Next r
             End If
     Next WkSht
End Sub

---

现在的问题是，它只从每个工作表中获取最后一个匹配项-比如说一月有四个匹配项，它只粘贴第四个项，然后下一行它将粘贴二月的最后一个项，等等。然后如果说十一月有一个匹配项，它将从开始粘贴到第11行，而不是一个接一个地粘贴每个条目。

您不需要VBA-只需在“其他”选项卡中引用单元格即可：

SheetName!CellAddress

在单元格地址前面加上工作表名称，然后加上感叹号

如果您需要VBA，那么我错误地理解了您的问题

编辑：

让我们从问题B开始：

正在将复制的行全部放在摘要选项卡的一行中

让我们看看用于粘贴值的代码：

Sheets("Summary").Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues

在这里，您总是将所有内容粘贴在相同的位置，即单元格A65536中，并将其偏移1。在循环的每次迭代中，值都将位于相同的位置。将偏移量1更改为

Offset(0, r)

现在，在每次迭代中，您将粘贴到不同的行上，因为r将是1，2，…，1000。请参阅MSDN以获取有关的文档。选择以所需方式完成粘贴的值

让我们转到下一个问题：

a它正在复制所有列

---

第一部分工作正常后，我将对其进行编辑。

最好创建一个从CommandButton1调用的子程序。然后可以从多个位置调用该过程。您还可以使用输入参数“transferID”对其进行泛化，该参数定义了所需的摘要

Private Sub CommandButton1_Click()
    Call PrintSummary("Incorrectly Assigned")
End Sub

它可能需要一些调整来实现您想要的效果，但这应该会给您一些想法来开始：

Sub PrintSummary(transferID As String)

    Dim ws      As Excel.Worksheet
    Dim wso     As Excel.Worksheet
    Dim lrow    As Long
    Dim rng     As Excel.Range
    Dim rngo    As Excel.Range
    Dim cell    As Excel.Range
    Dim colH    As Variant
    Dim i       As Integer

    '// Define columns for output
    colH = Array("G", "H", "I", "J", "K")

    '// Check for summary sheet (for output)
    On Error Resume Next
    Set wso = ThisWorkbook.Worksheets("Summary")
    On Error GoTo 0

    If wso Is Nothing Then

        '// Summary worksheet does not exist :/
        Exit Sub

    Else '// format worksheet for output

        '// for example...
        wso.Cells.Delete Shift:=xlUp
        Set rngo = wso.Range("A1") '// define output start
        Set wso = Nothing

    End If

    '// Loop through worksheets
    For Each ws In ThisWorkbook.Worksheets

        '// Check for valid worksheet name
        Select Case VBA.UCase(ws.Name)

            Case "JAN", "FEB" '// and so forth...

                Set rng = ws.Range("L1")
                Set rng = ws.Range(rng, ws.Cells(Rows.Count, rng.Column).End(xlUp))

                For Each cell In rng

                    If (VBA.UCase(cell.Text) = VBA.UCase(transferID)) Then

                        '// Print meta data
                        rngo.Offset(lrow, 0).Value = ws.Name
                        rngo.Offset(lrow, 1).Value = transferID

                        '// Print values
                        For i = 0 To UBound(colH)

                            rngo.Offset(lrow, i + 2).Value = ws.Cells(cell.Row, VBA.CStr(colH(i))).Value

                        Next i

                        '// Update counter
                        lrow = lrow + 1

                    End If

                Next cell

            Case Else

                '// Not a month? do nothing

        End Select

    Next ws

End Sub

---

我可能不太清楚。。。因此，如果每个工作表中有300个条目，并且其中只有一部分被错误地指定为传输原理，我需要代码来搜索所有工作表，找到L列=错误指定的行，然后仅将这些行的G-K列粘贴到“摘要”选项卡中。@Becky McPhee这可以在引用其他页面上的范围时使用excel if语句来完成。只要可能，我会尽量避免VBA，因为它总是一种维护危险。但是，如果没有人在这方面打败我，我会尝试稍后给出VBA答案。我在原始问题中发布了我到目前为止拥有的VBA代码及其存在的问题。我在原始帖子中更新了代码，使用了我现在使用的代码，以及它存在的问题。谢谢你能展示一下你到目前为止一直在使用的代码，并解释一下哪些代码不起作用吗？在过去的几天里，我一直在尝试从谷歌搜索中发现的一些不同的东西-我会尝试重新定位最有效的代码，并将其与发生的错误一起发布到此处。@EWit我在原始问题中发布了代码，并解释了我遇到的问题。