需要將多個Excel工作表中的數據匯總到一個匯總頁上

Question

我正在嘗試為我們的某些匯款創建年度摘要。 本質上，我有12張紙，一年中的每個月一張，並且在L列中為每個條目提供四個特定的“轉移原理”之一。我需要能夠創建一個工作表，使我能夠連續基於每個轉讓理由的日期摘要。

舉例來說，例如，我正在查看的轉移原理被稱為“分配不正確”-我認為需要使摘要頁顯示每行的GK列，其中所有十二個月的工作表中的L列都是“分配不正確”。

我一直在查看VBA代碼，並嘗試調整一些代碼來工作，但是我可以使用一些幫助！

編輯：

顯然，它無法按我的需要工作，或者我不會在這里，但我對VBA的了解不多。 我在這里有一些代碼在抓取L列符合條件的條目，但這是

a）復制所有列，我只需要粘貼GK，並且

b）將所有復制的行都放在“摘要”選項卡中的一行中，這樣我就可以瞬間看到數據，然后它將用下一行覆蓋，依此類推，直到最終確定在找到的最后一個條目上為止。

第二編輯：

因此，我有一個現在可以正常使用的代碼，我將其粘貼在下面並刪除了上面的舊代碼。

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月有一個匹配的條目，它將從頭開始粘貼在第11行，而不是每個條目都一個接一個地粘貼。

Answer 1

您不需要VBA-只需引用其他選項卡中的單元格即可：

SheetName!CellAddress

在單元格地址前添加工作表名稱，並在其后帶有感嘆號。

如果您需要VBA，則我不正確地理解了您的問題。

編輯：

讓我們從問題B開始：

將復制的行全部放在“摘要”選項卡中的一行中

讓我們看一下用於粘貼值的代碼：

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

在這里，您總是將所有內容粘貼到同一位置，在A65536單元格中，將其偏移一。 在循環的每次迭代中，值將位於同一位置。 將偏移量（1）更改為

Offset(0, r)

現在，在每次迭代中，您將粘貼到不同的行上，因為r將為1，2，...，1000。有關Offset的文檔，請參見MSDN。 選擇一個可以按所需方式完成粘貼的值。

讓我們轉到下一個問題：

a）它正在復制所有列

第一部分工作完成后，我將進行編輯。

Answer 2

最好創建一個從“ 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