Extract one column of data from every tab and paste all data onto one tab

Question

I have an excel spreadsheet with 102 tabs-- each tab is formatted in the same way with several columns of operations. I want to copy the same column of data from each tab and put it on a single tab within the same worksheet, but I don't know how to paste each copy into a different column.

This question is very similar to the one asked here: Extract tabular data from every Excel tab, and paste data on a single sheet

I have tried many variations on the following code, but cannot figure it out. I am getting the following error:

Method 'Range' of object '_Worksheet' failed

I have pasted the code below. Thanks in advance for any and all help!

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

Range expects a letter for the column and you are passing a number. Use Cells() instead `.Cells(1,LColO ).` instead of `.Range(LColO & "1").` — Scott Craner, Jul 13 '16 at 20:22
Personally I would look at @ScottHoltzman has. It will be quicker for lots of data in that it does not involve the clipboard. — Scott Craner, Jul 13 '16 at 20:35
I thought I would have to use the clipboard if I only want to copy values...? — ARubaDubDub, Jul 13 '16 at 20:36
Nope, if you only want to copy values the quickest method is to directly assign the values to the new range. — Scott Craner, Jul 13 '16 at 20:38

score 2 · Accepted Answer · edited May 23 '17 at 12:08

In addition to what @Scott Craner said, you can also shorten the code to this:

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

To totally remove the clipboard (copy and paste).

Use this:

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

in place of the two lines for Copy and Paste.

.columns.count would still be referring to wsInput on your paste line. — gtwebb, Jul 13 '16 at 20:27
Holy smokes that runs fast! Thank you! I had to remove the `End If` after `Next`. Thanks again for the help @ScottHoltzman and everyone. — ARubaDubDub, Jul 14 '16 at 12:05
@ARubaDubDub - It's amazing what clean code (which takes time to learn) can do for a program :). Please mark as answered so others benefit going fwd. — Scott Holtzman, Jul 14 '16 at 13:01

Extract one column of data from every tab and paste all data onto one tab

1 Answers1