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

Question

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.

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.

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".

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

Is this possible?

Answer 1

Here are two VBA solutions. The first does this:

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

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.

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 .

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 SheetChange event by adding code to the workbook. You do this as follows:

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:

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

Answer 2

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.

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

Download RDBMerge

Answer 3

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