Question

我有一个带有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

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

Answer 1

请参阅此代码。

我修改了您的代码，以便它根本不使用.Select或.Activate。
我已对代码进行了评论，因此您无法理解它。：）
代码不使用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

这就是你的最终代码的样子。它避免使用.Select或.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

从每个Excel选项卡中提取表格数据，并将数据粘贴到单个工作表上

1 个答案: