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的聊天一样，已设置正确的参数。我删除了最后几段代码片段，因为它们非常不正确。如果有人仍然感兴趣，请查看编辑记录。

希望这是最后的编辑。 ;）

因此，所需的正确条件是：

工作表中的月份名称。我们使用了输入框。
我们检查行数。有三个条件：总共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

将多个工作表中的Excel数据复制到一个工作表中

4 个答案: