将Excel工作表中的Excel数据复制到一张工作表中
我曾尝试在网上search这个问题的各种答案，但找不到正确的答案。 我有一个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
我需要将这些数据复制到列出所有数据的单个表单中。 基本上它将新数据附加到旧数据的底部。 所以这将是一个大名单。
如何才能做到这一点？ 我所能看到的就是如何通过将所有的值相加来从多个数据中产生一个总数。 我只需要将数据列为一个大列表。
大规模编辑：
就像上次和Iain聊天一样，已经设置了正确的参数。 我删除了最后几个代码片段，因为它们是不正确的。 如果有人仍然感兴趣，请检查编辑历史logging。
希望这是最后的编辑。 ;）
所以，正确的条件是：
- 月份名称在工作表中。 我们为此使用了一个input框。
- 我们检查行数。 有三个条件：总计157行，总计41行，以及所有其他条件。
下面的子程序将做的伎俩。
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：查看注释并将其与MSDN数据库交叉引用。 这应该解释每个function/方法究竟在做什么。 希望这可以帮助！
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
创build一个包含所有合并数据的工作表“摘要”。 打开ThisWorkBook（只需在Excel工作簿中按ALT + F11，打开一个新窗口，工作表名称将显示在左侧，继续展开直到看到ThisWorkBook）双击ThisWorkBook并在其中添加以下代码：
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
Sub AddToMaster（）这个macros进入主工作簿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 Dim Dim i
设置wsMaster = ThisWorkbook.Sheets（“Sheet1”）
'指定文件夹path
FolderPath =“D：\ work \”
'指定文件名
FileName = Dir（FolderPath＆“. xls ”）
Do当FileName <>“”
NextRow = wsMaster.Range（“A”＆Rows.Count）.End（xlUp）.Row + 1
设置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（）循环
wbDATA.Close False End Sub