Excel VBA look through sheets and copy column range to another sheet

Question

I have what I think is a simple question, but I really cannot get my head around using loops...

I have 12 worksheets named Jan, Feb, Mar ... through to Dec and a Summary sheet.

I would like to loop through the 12 sheets and copy Column E from each tab and paste them in to the Summary sheet.

Jan Column E would paste to Summary Sheet column A, 
Feb Column E would paste to Summary Sheet column B,
Mar Column E would paste to Summary Sheet column C ... and so on.

I am using the following code, which works OK. But, I would really like to be able to use a loop to reduce the coding.

Sub Ops()

Sheets("Dec").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("A1").Select
ActiveSheet.paste

Sheets("Nov").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("B1").Select
ActiveSheet.paste

Sheets("Oct").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("C1").Select
ActiveSheet.paste

Sheets("Sep").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("D1").Select
ActiveSheet.paste

Sheets("Aug").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("E1").Select
ActiveSheet.paste

Sheets("Jul").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("F1").Select
ActiveSheet.paste

Sheets("Jun").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("G1").Select
ActiveSheet.paste

Sheets("May").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("H1").Select
ActiveSheet.paste

Sheets("Apr").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("I1").Select
ActiveSheet.paste

Sheets("Mar").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("J1").Select
ActiveSheet.paste

Sheets("Feb").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("K1").Select
ActiveSheet.paste

Sheets("Jan").Select
Columns("E:E").Select
Selection.Copy
Sheets("Summary by Operator").Select
Range("L1").Select
ActiveSheet.paste
Range("A1").Select

End sub

Answer 1

You could try the shorter code version.

Loop throught your `Worksheets(Array("Jan","Feb",....)), and for eachsheet (according to the order inside the array) it will copy column E to the next avialable column in "Summary" sheet, starting from "Jan" to column A (can easily be reveresd)

Code

Option Explicit

Sub CopySheetstoSummary()

    Dim ws As Worksheet
    Dim i As Long

    i = 1
    For Each ws In ThisWorkbook.Worksheets(Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"))
        ws.Columns("E:E").Copy Worksheets("Summary").Cells(1, i)
        i = i + 1
    Next ws

End Sub

Answer 2

sub test()
sht=workbook.sheets.count
for i =1 to sht
select case sheets(i).name
case "Dec"
    sheets("Dec").range(E:E).copy
    sheets("Summary").range("A1").paste
case "Nov"
    sheets("Nov").range(E:E).copy
    sheets("Summary").range("B1").paste
case "Oct"
    sheets("Oct").range(E:E).copy
    sheets("Summary").range("C1").paste
case "Sep"
    sheets("Sep").range(E:E).copy
    sheets("Summary").range("D1").paste
case "Aug"
    sheets("Aug").range(E:E).copy
    sheets("Summary").range("E1").paste
case "Jul"
    sheets("Jul").range(E:E).copy
    sheets("Summary").range("F1").paste
case "Jun"
    sheets("Jun").range(E:E).copy
    sheets("Summary").range("G1").paste
case "May"
    sheets("May").range(E:E).copy
    sheets("Summary").range("H1").paste
case "Apr"
    sheets("Apr").range(E:E).copy
    sheets("Summary").range("I1").paste
case "Mar"
    sheets("Mar").range(E:E).copy
    sheets("Summary").range("J1").paste
case "feb"
    sheets("Feb").range(E:E).copy
    sheets("Summary").range("K1").paste
case "Jan"
    sheets("Jan").range(E:E).copy
    sheets("Summary").range("L1").paste
end select
next i

end sub

Answer 3

So, I added a for loop plus there were some unnecesarry steps in your code. You should avoid .select like lines. I hope this will work, let me know.

Sub Ops()

for i = 1 to 12
Select case i
case 1
    Sheet = "Dec"
case 2
    Sheet = "Nov"
case 3
    Sheet = "Oct"
case 4
    Sheet = "Sep"
case 5
    Sheet = "Aug"
case 6
    Sheet = "Jul"
case 7
    Sheet = "Jun"
case 8
    Sheet = "May"
case 9
    Sheet = "Apr"
case 10
    Sheet = "Mar"
case 11
    Sheet = "Feb"
case 12
    Sheet = "Jan"
End select
Sheets("" & Sheet & "").Columns("E:E").Copy
Sheets("Summary by Operator").Cells(1,i).paste
next i

end sub

Answer 4

Try this:

Sub PasteColumns()
    Dim arrSheets As Variant

    ' Define sheet names
    ' ------------------------
    arrSheets = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

    Dim sSheet As Worksheet
    For i = 0 To UBound(arrSheets)
        ' Check sheet exists
        ' -------------------
        On Error Resume Next
        Set sSheet = ThisWorkbook.Sheets(arrSheets(i))
        On Error GoTo 0

        ' Insert values in appropriate column
        ' --------------------------------------
        If Not sSheet Is Nothing Then
            ThisWorkbook.Sheets("Summary by Operator").Columns(i + 1).Value = sSheet.Columns(5).Value
        End If

        Set sSheet = Nothing
    Next
End Sub

Answer 5

For "Jan" in col A on the Summary's sheet :

Option Explicit

Sub Ops_With_Loops()
    Dim SheetsNames As String
    Dim SheetName() As String
    Dim wS As Worksheet
    Dim wSUM As Worksheet
    Dim i As Integer

    Set wSUM = ThisWorkbook.Sheets("Summary by Operator")
    SheetsNames = "Jan/Fev/Mar/Apr/May/Jun/Jul/Aug/Sep/Oct/Nov/Dec"
    SheetName = Split(SheetsNames, "/")

    For i = LBound(SheetName) To UBound(SheetName)
        Set wS = ThisWorkbook.Sheets(SheetName(i))
        wS.Columns("E:E").Copy wSUM.Cells(1, i + 1)
    Next i
End Sub

For "Jan" in col L on the Summary's sheet :

Option Explicit

Sub Ops_With_Loops()
    Dim SheetsNames As String
    Dim SheetName() As String
    Dim wS As Worksheet
    Dim wSUM As Worksheet
    Dim i As Integer

    Set wSUM = ThisWorkbook.Sheets("Summary by Operator")
    SheetsNames = "Jan/Fev/Mar/Apr/May/Jun/Jul/Aug/Sep/Oct/Nov/Dec"
    SheetName = Split(SheetsNames, "/")

    For i = LBound(SheetName) To UBound(SheetName)
        Set wS = ThisWorkbook.Sheets(SheetName(UBound(SheetName) - i))
        .Columns("E:E").Copy wSUM.Cells(1, i + 1)
    Next i
End Sub

---

A basic thing to do to reduce code (and really improve its efficiency), is to get rid of all Select :

Sub Ops_basics()

Sheets("Dec").Columns("E:E").Copy
Sheets("Summary by Operator").Range("A1").Paste

Sheets("Nov").Columns("E:E").Copy
Sheets("Summary by Operator").Range("B1").Paste

Sheets("Oct").Columns("E:E").Copy
Sheets("Summary by Operator").Range("C1").Paste

Sheets("Sep").Columns("E:E").Copy
Sheets("Summary by Operator").Range("D1").Paste

Sheets("Aug").Columns("E:E").Copy
Sheets("Summary by Operator").Range("E1").Paste

Sheets("Jul").Columns("E:E").Copy
Sheets("Summary by Operator").Range("F1").Paste

Sheets("Jun").Columns("E:E").Copy
Sheets("Summary by Operator").Range("G1").Paste

Sheets("May").Columns("E:E").Copy
Sheets("Summary by Operator").Range("H1").Paste

Sheets("Apr").Columns("E:E").Copy
Sheets("Summary by Operator").Range("I1").Paste

Sheets("Mar").Columns("E:E").Copy
Sheets("Summary by Operator").Range("J1").Paste

Sheets("Feb").Columns("E:E").Copy
Sheets("Summary by Operator").Range("K1").Paste

Sheets("Jan").Columns("E:E").Copy
Sheets("Summary by Operator").Range("L1").Paste


End Sub