Question

我有一个带有102个标签的Excel电子表格 - 每个标签的格式都与几列操作相同。我想从每个选项卡中复制相同的数据列并将其放在同一工作表中的单个选项卡上，但我不知道如何将每个副本粘贴到不同的列中。

这个问题与这里提出的问题非常相似： Extract tabular data from every Excel tab, and paste data on a single sheet

我已尝试过以下代码的许多变体，但无法弄清楚。我收到以下错误：

对象'_Worksheet'的方法'范围'失败

我已粘贴以下代码。在此先感谢您的帮助！

Option Explicit


Sub CopyPasteCombineSI()
Dim wsInput As Worksheet, wsOutput As Worksheet
Dim rngSI As Range, rngHeading As Range
Dim LColO As Long, LRowI As Long, LastColumn As Long

'~~> Set your Output Sheet
Set wsOutput = ThisWorkbook.Sheets("Dual Flow")

'~~> Loop through all sheets to copy and paste combined SI data
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
            '~~> Set your range for copying
            Set rngHeading = .Range("E1")
            '~~> Copy your range
            rngHeading.Copy
            '~~> Paste
            .Range("F1").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            '~~> Get the last row of input sheet
            LRowI = .Range("A" & .Rows.Count).End(xlUp).Row
            '~~> Set your range for copying
            Set rngSI = .Range("F1:F" & LRowI)
            '~~> Copy your range
            rngSI.Copy
            '~~> Pasting data in the output sheet
            With wsOutput
                If WorksheetFunction.CountA(Cells) > 0 Then
                    'Search for any entry, by searching backwards by Columns.
                    LastColumn = Cells.Find(What:="*", After:=[A1], _
                    SearchOrder:=xlByColumns, _
                    SearchDirection:=xlPrevious).Column
                Else
                    LastColumn = 0
                End If
                '~~> Get the next available column in output sheet for pasting
                LColO = LastColumn + 1

                '~~> Finally paste
                .Range(LColO & "1").PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            End With
        End With
    End If
Next wsInput

Exit Sub
End Sub

Answer 1

除@Scott Craner所说的内容外，您还可以将代码缩短为：

Sub CopyPasteCombineSI()

Dim wsInput As Worksheet, wsOutput As Worksheet
Dim LRowI As Long

'~~> Set your Output Sheet
Set wsOutput = ThisWorkbook.Sheets("Dual Flow")

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
            '~~> Set your range for copying
            .Range("F1").Value = .Range("E1").Value
            '~~> Get the last row of input sheet
             LRowI = .Range("A" & .Rows.Count).End(xlUp).Row
            '~~> Copy your range
            .Range("F1:F" & LRowI).Copy
            '~~> paste range to next available column, assumes headers in row 1 
            wsOutput.Cells(1, wsOutput.Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial xlPasteValues
        End With
    End If
Next

End Sub

完全删除剪贴板（复制和粘贴）。

使用此：

With wsOutput
    .Cells(1,.Columns.Count).End(xlToLeft).Offset(, 1).Resize(LRowI).Value = wsInput.Range("F1:F" & LRowI).Value
End With

代替复制和粘贴两行。

从每个标签中提取一列数据，并将所有数据粘贴到一个标签

1 个答案: