將多個工作表中的Excel數據復制到一個工作表中

Question

我試過在互聯網上搜索這個問題的各種答案，但找不到正確的答案。 我有一個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

我需要將這些數據復制到一張列出所有數據的單頁中。 基本上，它將新數據附加到舊數據的底部。 所以這將是一個大清單。

如何才能做到這一點？ 我所能看到的是如何通過將所有值一起添加來從多個數據中生成總計。 我只需將數據列為一個大清單。

Answer 1

大規模編輯：

與上次與Iain聊天一樣，已設置正確的參數。 我刪除了最后幾段代碼片段，因為它們非常不正確。 如果有人仍然感興趣，請查看編輯歷史記錄。

希望這是最后的編輯。 ;）

因此，所需的正確條件是：

1. 工作表中的月份名稱。 我們使用了輸入框。
2. 我們檢查行數。 有三個條件：總共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數據庫交叉引用它們。 這應該解釋每個函數/方法正在做什么。 希望這可以幫助！

Answer 2

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

Answer 3

創建一個工作表“摘要”，其中包含所有合並的數據。 打開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 

Answer 4

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