Copy values in a column from multiple worksheets into one

Question

The problem is the following: I have an excel file with multiple worksheets and I needed to copy the G column from every worksheet to a single new worksheet ( the columns should be next to each other or with an empty column between the columns with data). I also wanted to ask if it is possible to put the name of each worksheet above the corresponding column.

Until now, I used this code:

Sub Copy_G_Columns()
    Dim ws As Worksheet, i As Long
    Application.ScreenUpdating = False
    On Error Resume Next
        Set ws = Sheets("Gee Columns")
            If Err.Number <> 0 Then
                ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Sheets(Sheets.Count): ActiveSheet.Name = "Gee Columns"
                    On Error GoTo 0
                Else
                Sheets("Gee Columns").Select
            End If

        For i = 1 To ActiveWorkbook.Sheets.Count - 1
            With Sheets(i)
                    .Range("G1:G" & .Cells(.Rows.Count, 7).End(xlUp).Row).Copy Cells(2, i * 2 - 1)
                Cells(1, i * 2 - 1) = Sheets(i).Name
            End With
        Next i

    Application.ScreenUpdating = True
End Sub

It seems to almost work perfectly. The only problem is that in the new created sheet, the values in the columns have a #DIV/0 error. I think the problem is that the code is copying the formats and not the values.

Answer 1

Here is my interpretation of your code.

Option Explicit

Sub allGEE()
    Dim w As Long, wsn As String, vGEEs As Variant

    wsn = "Gee Columns"

    For w = 1 To Worksheets.Count
        With Worksheets(w)
            On Error GoTo bm_NeedWorksheet
            If .Name <> Worksheets(wsn).Name Then
                On Error GoTo bm_Safe_Exit
                vGEEs = .Range(.Cells(1, 7), .Cells(Rows.Count, 7).End(xlUp)).Value
                vGEEs(1, 1) = .Name
                With Worksheets(wsn).Cells(1, w * 2 - 1)
                    .Resize(UBound(vGEEs, 1), UBound(vGEEs, 2)) = vGEEs
                End With
            End If
        End With
    Next w

    GoTo bm_Safe_Exit

bm_NeedWorksheet:
    On Error GoTo 0
    With Worksheets.Add(after:=Sheets(Sheets.Count))
        .Name = wsn
    End With
    Resume
bm_Safe_Exit:
End Sub

I've retained the stagger in the destination cells. I strongly suspect that you were copying formulas across and needed the values only. Transferring values with a variant array (without the clipboard) is quicker. Direct value transfer is also possible but you wanted to put the origin worksheet name into the first cell(s).