vba 将多个工作表中的 Excel 数据复制到一张工作表中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/20066005/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copying Excel data from multiple worksheets into one single sheet
提问by Iain Blackwood
I have tried searching the internet for various answers to this question but cannot find the right answer. I have an Excel Workbook with worksheets represent each day of the month. In each of these sheets the format is the same (except on Saturdays and Sundays) and the sheets contain call stats. It is presented in the following format:
我曾尝试在互联网上搜索这个问题的各种答案，但找不到正确的答案。我有一个 Excel 工作簿，其中的工作表代表一个月中的每一天。在这些工作表中的每一个中，格式都是相同的（周六和周日除外）并且工作表包含呼叫统计信息。它以以下格式呈现：
00:00 00:30 0 4 6 3 4 8 0 1 0 0 0
00:00 00:30 0 0 2 7 4 1 0 0 3 3 0
00:00 00:30 7 0 7 5 2 8 6 1 7 9 0
00:00 00:30 0 4 6 3 4 8 0 1 0 0 0
00:00 00:30 0 0 2 7 4 1 0 0 3 3 0
00:00 00:30 7 0 7 5 2 8 9 6 1 0
I need to copy this data into 1 single sheet that lists all the data. Basically it appends the new data on to the bottom of the old data. So it will be one big list.
我需要将这些数据复制到一张列出所有数据的工作表中。基本上它将新数据附加到旧数据的底部。所以这将是一个大名单。
How can this be done? All I can see is how to produce a total from multiple data by adding all the values together. I just need to list the data as one big list.
如何才能做到这一点？我所能看到的就是如何通过将所有值相加来从多个数据中产生一个总数。我只需要将数据列为一个大列表。
回答by Jerome Montino
MASSIVE EDIT:
大规模编辑：
As with last chat with Iain, the correct parameters have been set. I have removed the last few code snippets as they are quite not right. If anyone is still interested, please check the edit history.
与上次与 Iain 的聊天一样，已经设置了正确的参数。我已经删除了最后几个代码片段，因为它们很不正确。如果还有人感兴趣，请查看编辑历史。
Hopefully, this is the final edit. ;)
希望这是最后的编辑。;)
So, the correct conditions needed are:
因此，所需的正确条件是：
- Month name in sheet. We used an Input Box for this.
- We check for number of rows. There are three conditions: 157 rows total, 41 rows total, and all else.
- 工作表中的月份名称。我们为此使用了输入框。
- 我们检查行数。共有三个条件：总共 157 行，总共 41 行，以及所有其他条件。
The following subroutine will do the trick.
下面的子程序可以解决这个问题。
Sub BlackwoodTransfer()
Dim Summ As Worksheet, Ws As Worksheet
Dim ShName As String
Dim nRow As Long
Set Summ = ThisWorkbook.Sheets("Summary")
ShName = InputBox("Enter month for Call Flow in mmmm format (ie. November, etc.):") & " Call Flow"
'Returns November Call Flow. This means it will target every sheet that has November Call Flow in its name.
Application.ScreenUpdating = False
For Each Ws In ThisWorkbook.Worksheets
If InStr(1, Ws.Name, ShName) > 0 Then
'Starting from first character of the sheet's name, if it has November, then...
nRow = Summ.Cells(Rows.Count, 1).End(xlUp).Row + 1
'... get the next empty row of the Summary sheet...
Select Case Ws.Cells(Rows.Count, 1).End(xlUp).Row
'... check how many rows this qualified sheet has...
Case 157
'... if there are 157 rows total...
Ws.Range(Cells(57,1),Cells(104,13)).Copy
'... copy Rows 57 to 104, 13 columns wide...
Summ.Range("A" & nRow).PasteSpecial xlPasteAll
'... and paste to next empty row in Summary sheet.
Case 41
Ws.Range(Cells(23,1),Cells(126,13)).Copy
Summ.Range("A" & nRow).PasteSpecial xlPasteAll
Case Else
Ws.Range(Cells(23,1),Cells(30,13)).Copy
Summ.Range("A" & nRow).PasteSpecial xlPasteAll
End Select
End If
Next Ws
Application.ScreenUpdating = True
End Sub
@Iain: Check out the comments and cross reference them with the MSDN database. That should explain what each function/method is doing exactly. Hope this helps!
@Iain：查看评论并将它们与 MSDN 数据库交叉引用。这应该解释每个函数/方法在做什么。希望这可以帮助！
回答by Huy Pham
Sub CombineSheets()
Dim ws As Worksheet, wsCombine As Worksheet
Dim rg As Range
Dim RowCombine As Integer
Set wsCombine = ThisWorkbook.Worksheets.Add(ThisWorkbook.Worksheets(1))
wsCombine.Name = "Combine"
RowCombine = 1
For Each ws In ThisWorkbook.Worksheets
If ws.Index <> 1 Then
Set rg = ws.Cells(1, 1).CurrentRegion
rg.Copy wsCombine.Cells(RowCombine, 2)
wsCombine.Range(Cells(RowCombine, 1), Cells(RowCombine + rg.Rows.Count - 1, 1)) = ws.Name
RowCombine = RowCombine + rg.Rows.Count
End If
Next
wsCombine.Cells(1, 1).EntireColumn.AutoFit
Set rg = Nothing
Set wsCombine = Nothing
End Sub
回答by Wasiq Ali
Create a worksheet "Summary" which is to contain all the merged data. Open ThisWorkBook (simply press ALT+F11 in your excel workbook. A new window will open. Your worksheet name will be visible on the left hand side. Keep expanding till you see ThisWorkBook) Double click ThisWorkBook and add the following code in it:
创建一个包含所有合并数据的工作表“摘要”。打开此工作簿（只需在您的 Excel 工作簿中按 ALT+F11。将打开一个新窗口。您的工作表名称将在左侧可见。继续展开直到您看到此工作簿）双击此工作簿并在其中添加以下代码：
Sub SummurizeSheets()
Dim ws As Worksheet
Application.Screenupdating = False
Sheets("Summary").Activate
For Each ws In Worksheets
If ws.Name <> "Summary" Then
ws.Range("F46:O47").Copy
ActiveSheet.Paste Range("A65536").End(xlUp).Offset(1, 0)
End If
Next ws
End Sub
回答by karnati
Sub AddToMaster()
'this macro goes IN the master workbook
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long
Dim FileName As String
Dim FolderPath As String
Dim n As Long
Dim i
Set wsMaster = ThisWorkbook.Sheets("Sheet1")
'Specify the folder path
FolderPath = "D:\work\"
'specifying file name
FileName = Dir(FolderPath & "*.xls*")
Do While FileName <> ""
NextRow = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1
Set wbDATA = Workbooks.Open(FolderPath & FileName)
With wbDATA.Sheets("product_details")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
' If LastRow > 5 Then
For i = 2 To LastRow
.Range("A2:j" & i).Copy
wsMaster.Range("A" & NextRow).PasteSpecial xlPasteValues
'Set NextRow = NextRow
Next i
End With
FileName = Dir()
Loop
wbDATA.Close False
End Sub
