1

我有一个包含 75 个选项卡的 excel 电子表格——每个选项卡的格式相同，包含两列单词。我希望所有这些数据都在一个页面上，但我不知道如何以编程方式从每个选项卡中提取表格并将其粘贴到单个选项卡上。

有没有办法在 Excel 中做到这一点？

好的，这是我尝试过的代码：

Sub Macro5()

    Range("A1:B30").Select
    Selection.Copy
    Sheets("Table 1").Select
    Selection.End(xlDown).Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
End Sub

所有选项卡的格式都相同，所有单元格中的数据都来自 A1:B30。我在想 Selection.End 命令将转到下一个可用的打开单元格，并将后续选项卡中的数据粘贴到该单元格中。

截至目前，我需要转到每个选项卡并单独运行此宏，但它不起作用，因为它说粘贴的数据与现有数据的类型/格式不同。

有任何想法吗？

编码尝试#2-成功！！！

    Sub Macro5()

    Dim ws As Worksheet
        For Each ws In ActiveWorkbook.Worksheets
            ws.activate
            Range("A1:B30").Select
            Selection.Copy
            Sheets("Table 1").Select
            Selection.End(xlDown).Select
            Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                , SkipBlanks:=False, Transpose:=False

            On Error Resume Next 'Will continue if an error results

            Next ws
End Sub

好吧，我不想承认我很高兴你不只是用勺子喂给我答案。看好你，先生。

编码尝试#3-避免选择

Sub Macro5()

    Dim ws As Worksheet
        For Each ws In ActiveWorkbook.Worksheets
            Set Rng = ws.Range("A1:B30")
            Rng.Copy

            Dim ws1 As Worksheet
            Set ws1 = Worksheets("Table 1")
            ws1.Select
            Selection.End(xlDown).Select
            Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                , SkipBlanks:=False, Transpose:=False

            On Error Resume Next 'Will continue if an error results
            Next ws
End Sub

不太正确——它仍然有效，但我不确定当我进入第一个工作簿时如何避免使用“选择”。有没有办法引用最接近的没有内容的单元格？我知道“结束”键可以做到这一点，但有没有基于非选择的方式？

4

1 回答 1

2

请参阅此代码。

  1. 我修改了您的代码，使其不使用.Select或根本不使用.Activate。
  2. 我已经对代码进行了注释，因此您理解它应该没有问题。:)
  3. 该代码不使用On Error Resume Next. 除非有必要，否则您应该始终避免这种情况。改为使用适当的错误处理。考虑On Error Resume Next告诉您的应用程序简单地关闭。:)

这是基本错误处理的示例

Sub Sample()
    On Error GoTo Whoa

    '
    '~~> Rest of Code
    '

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

所以这就是你的最终代码的样子。它避免使用.Selector .Activate。它还避免使用Selection并找到需要复制的确切范围和需要复制的确切范围。它还进行适当的错误处理。

Option Explicit

Sub Sample()
    Dim wsInput As Worksheet, wsOutput As Worksheet
    Dim rng As Range
    Dim LRowO As Long, LRowI As Long

    On Error GoTo Whoa

    '~~> Set your Output Sheet
    Set wsOutput = ThisWorkbook.Sheets("Table 1")

    '~~> Loop through all sheets
    For Each wsInput In ThisWorkbook.Worksheets
        '~~> Ensure that we ignore the output sheet
        If wsInput.Name <> wsOutput.Name Then
            '~~> Working with the input sheet
            With wsInput
                '~~> Get the last row of input sheet
                LRowI = .Range("A" & .Rows.Count).End(xlUp).Row
                '~~> Set your range for copying
                Set rng = .Range("A1:B" & LRowI)
                '~~> Copy your range
                rng.Copy
                '~~> Pasting data in the output sheet
                With wsOutput
                    '~~> Get the next available row in output sheet for pasting
                    LRowO = .Range("A" & .Rows.Count).End(xlUp).Row + 1

                    '~~> Finally paste
                    .Range("A" & LRowO).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                End With
            End With
        End If
    Next wsInput

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub
于 2012-08-03T04:52:31.610 回答