Extract tabular data from every Excel tab, and paste data on a single sheet

Question

I have an excel spreadsheet with 75 tabs-- each tab is formatted in the same way with two columns of words. I want all of this data to be on just a single page, but I don't know how to programmatically extract tables from each tab and paste it on a single tab.

Is there a way to do this in Excel?

---

Alright, here's the code that I've tried:

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

All tabs are formatted in the same way, with data in all cells from A1:B30. I'm thinking that the Selection.End command would go to the next available open cell and paste data from the subsequent tabs in that.

As of current, I would need to go to each tab and individually run this macro, except that it doesn't work because it says the pasted data is not of the same type/format of the existing data.

Any ideas?

---

Coding attempt #2- SUCCESS!!!

    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

Well, I hate to admit I'm glad you didn't just spoonfeed me the answer. Good on you, sir.

---

Coding Attempt #3- Avoid Selections

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

Not quite right-- it still works, but I'm not sure how to avoid using "Selection" when I get to the first workbook. Is there a way to reference the most proximate cell without content? I know the 'End' key can do this, but is there a non-selection based way?

Answer 1

See this code.

1. I modified your code so that it doesn't use .Select or .Activate at all.
2. I have commented the code so you shouldn't have a problem understanding it. :)
3. The code doesn't use On Error Resume Next. You should always avoid that unless it is necessary. Use proper error handling instead. Consider On Error Resume Next as telling your application to simply SHUT UP. :)

Here is an example of basic error handling

Sub Sample()
    On Error GoTo Whoa

    '
    '~~> Rest of Code
    '

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

So this is how your final code will look like. It avoids the use of .Select or .Activate. It also avoids the use of Selection and finds the exact range that needs to be copied and exact range where it needs to be copied. Also it does proper error handling.

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