vba Excel：跨多个工作表填充数据

Excel: Populate Data Across Multiple Worksheets

提问by Brandon

Unfortunately for my employer, none of my network engineering courses included advanced Excel formula programming. Needless to say, I know nothing about Excel save for basic SUM and COUNT formula commands.

对我的雇主来说不幸的是，我的网络工程课程都没有包含高级 Excel 公式编程。不用说，我对 Excel 对基本 SUM 和 COUNT 公式命令的保存一无所知。

My employer has an Excel workbook with multiple worksheets within it representing each month of the calendar year. We want to be able to have a "total" worksheet in the workbook that reflects all data across the entire workbook in each column/row.

我的雇主有一个 Excel 工作簿，其中包含多个工作表，代表日历年的每个月。我们希望能够在工作簿中拥有一个“总计”工作表，以反映每列/行中整个工作簿中的所有数据。

An example for the sake of clarity:

为了清楚起见，举个例子：

• In the worksheet "May_2013", column A is labeled "DATE". Cell A2 contains the data "MAY-1".

• In the worksheet "June_2013", column A is labeled "DATE". Cell A2 contains the data "JUNE-1".

• In the worksheet "Total", column A is labeled "DATE". We want cells A2 to reflect "MAY-1" and A3 to reflect "JUNE-1".

• 在工作表“May_2013”​​中，A 列标记为“DATE”。单元格 A2 包含数据“MAY-1”。

• 在工作表“June_2013”​​中，A 列标记为“DATE”。单元格 A2 包含数据“JUNE-1”。

• 在工作表“总计”中，A 列标记为“日期”。我们希望单元格 A2 反映“MAY-1”，A3 反映“JUNE-1”。

We want to do this for all worksheets, columns A-Q, rows 2-33 and populate a master sheet at the very end containing all data in all worksheets in their corresponding columns.

我们希望对所有工作表、AQ 列、第 2-33 行执行此操作，并在最后填充一个主表，其中包含所有工作表中相应列中的所有数据。

Is this possible?

这可能吗？

回答by Floris

Here are two VBA solutions. The first does this:

这里有两个 VBA 解决方案。第一个这样做：

1. Check if a sheet "totals" exists. Create it if it does not
2. Copy the first row (A to Q) of first sheet to "totals"
3. Copy block A2:Q33 to "totals" sheet starting at row 2
4. Repeat for all other sheets, appending 32 rows lower each time

1. 检查工作表“总计”是否存在。如果没有就创建它
2. 将第一张表的第一行（A 到 Q）复制到“总计”
3. 将块 A2:Q33 复制到从第 2 行开始的“总计”表
4. 对所有其他工作表重复，每次追加 32 行

The second shows how to do some manipulation of the column data before copying: for each column it applies the WorksheetFunction.Sum(), but you could replace that with any other aggregating function that you would like to use. It then copies the result (one row per sheet) to the "totals" sheet.

第二个显示了如何在复制之前对列数据进行一些操作：对于每一列，它应用WorksheetFunction.Sum()，但您可以将其替换为您想要使用的任何其他聚合函数。然后将结果（每张纸一行）复制到“总计”表中。

Both solutions are in the workbook you can download from this site. Run the macros with , and pick the appropriate one from the list of options that shows up. You can edit the code by invoking the VBA editor with .

这两种解决方案都在您可以从该站点下载的工作簿中。使用 运行宏，然后从显示的选项列表中选择合适的宏。您可以通过调用 VBA 编辑器来编辑代码。

Sub aggregateRaw()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range

sheetCount = ActiveWorkbook.Sheets.Count

' add a new sheet at the end:
If Not worksheetExists("totals") Then
  Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
  newSheet.Name = "totals"
Else
  Set newSheet = ActiveWorkbook.Sheets("totals")
End If

Set targetRange = newSheet.[A1]

' if you want to clear the sheet before copying data, uncomment this line:
' newSheet.UsedRange.Delete

' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
ActiveWorkbook.Sheets(1).Range("1:1").Copy targetRange

Set targetRange = targetRange.Offset(1, 0) ' down a row
' copy blocks of data from A2 to Q33 into the "totals" sheet
For Each ws In ActiveWorkbook.Worksheets
  If ws.Name <> newSheet.Name Then
    ws.Range("A2", "Q33").Copy targetRange
    Set targetRange = targetRange.Offset(32, 0) ' down 32 rows
  End If
Next ws

End Sub

Sub aggregateTotal()
Dim thisSheet, newSheet As Worksheet
Dim sheetCount As Integer
Dim targetRange As Range
Dim columnToSum As Range

sheetCount = ActiveWorkbook.Sheets.Count

' add a new sheet at the end:
If Not worksheetExists("totals") Then
  Set newSheet = ActiveWorkbook.Sheets.Add(after:=Sheets(sheetCount))
  newSheet.Name = "totals"
Else
  Set newSheet = Sheets("totals")
End If

' assuming you want to copy the headers, and that they are the same
' on all sheets, you can copy them to the "totals" sheet like this:
Set targetRange = newSheet.[A1]
ActiveWorkbook.Sheets(1).Range("A1:Q1").Copy targetRange

Set targetRange = targetRange.Offset(1, 0) ' down a row

For Each ws In ActiveWorkbook.Worksheets
  ' don't copy data from "total" sheet to "total" sheet...
  If ws.Name <> newSheet.Name Then
    ' copy the month label
    ws.[A2].Copy targetRange

    ' get the sum of the coluns:
    Set columnToSum = ws.[B2:B33]
    For colNum = 2 To 17 ' B to Q
      targetRange.Offset(0, colNum - 1).Value = WorksheetFunction.Sum(columnToSum.Offset(0, colNum - 2))
    Next colNum
    Set targetRange = targetRange.Offset(1, 0) ' next row in output
  End If

Next ws

End Sub

Function worksheetExists(wsName)
' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html
worksheetExists = False
On Error Resume Next
worksheetExists = (Sheets(wsName).Name <> "")
On Error GoTo 0
End Function

Final(?) edit:If you want this script to run automatically every time someone makes a change to the workbook, you can capture the SheetChangeevent by adding code to the workbook. You do this as follows:

Final(?) 编辑：如果您希望每次有人对工作簿进行更改时都自动运行此脚本，您可以SheetChange通过向工作簿添加代码来捕获该事件。您可以按如下方式执行此操作：

1. open the Visual Basic editor ()
2. In the project explorer (left hand side of the screen), expand the VBAProject
3. Right-click on "ThisWorkbook", and select "View Code"
4. In the window that opens, copy/paste the following lines of code:

1. 打开 Visual Basic 编辑器 ()
2. 在项目资源管理器（屏幕左侧）中，展开 VBAProject
3. 右键单击“ThisWorkbook”，然后选择“查看代码”
4. 在打开的窗口中，复制/粘贴以下代码行：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' handle errors gracefully:
On Error GoTo errorHandler

' turn off screen updating - no annoying "flashing"
Application.ScreenUpdating = False

' don't respond to events while we are updating:
Application.EnableEvents = False

' run the same sub as before:
aggregateRaw

' turn screen updating on again:
Application.ScreenUpdating = True

' turn event handling on again:
Application.EnableEvents = True

Exit Sub ' if we encountered no errors, we are now done.

errorHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
' you could add other code here... for example by uncommenting the next two lines
' MsgBox "Something is wrong ... " & Err.Description
' Err.Clear

End Sub

回答by grandocu

You can use the indirect function to reference the sheet name. In the image below this function takes the header name (B37) and uses it as the sheet reference. All you have to do is choose the correct "total cell" which I made "A1" in "MAY_2013". I put an image below to show you my reference name as well as tab name

您可以使用间接函数来引用工作表名称。在下图中，此函数采用标题名称 (B37) 并将其用作工作表参考。您所要做的就是选择我在“MAY_2013”​​中制作的“A1”正确的“总单元格”。我在下面放了一张图片来向您展示我的参考名称和选项卡名称

回答by Santosh

Kindly use RDBMerge add-in which will combine the data from different worksheet and create a master sheet for you. Please see the below link for more details.

请使用 RDBMerge 插件，它将合并来自不同工作表的数据并为您创建一个主表。请参阅以下链接了解更多详情。

http://duggisjobstechnicalstuff.blogspot.in/2013/03/how-to-merge-all-excel-worksheets-with.html

http://duggisjobstechnicalstuff.blogspot.in/2013/03/how-to-merge-all-excel-worksheets-with.html

Download RDBMerge

下载 RDBMerge