Excel VBA 浏览工作表并将列范围复制到另一个工作表答案

【问题标题】：Excel VBA look through sheets and copy column range to another sheetExcel VBA 浏览工作表并将列范围复制到另一个工作表
【发布时间】：2017-02-14 12:49:09
【问题描述】：

我有一个我认为很简单的问题，但我真的无法理解使用循环...

我有 12 个工作表，分别命名为 Jan、Feb、Mar ... 到 Dec 和一个摘要表。

我想遍历 12 个工作表并从每个选项卡中复制 E 列并将它们粘贴到摘要工作表中。

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.

我正在使用以下代码，它可以正常工作。但是，我真的很希望能够使用循环来减少编码。

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

【问题讨论】：

您说 Jan Column E 将粘贴到 Summary Sheet 列 A，但您的代码将 Jan in col L 放在摘要中？是哪一个？？

标签： vba excel loops

【解决方案1】：

试试这个：

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

【讨论】：

@BoffWx 很好地处理了sSheet 工作表对象的可能错误

【解决方案2】：

您可以尝试更短的代码版本。

循环遍历您的`Worksheets(Array("Jan","Feb",....))，并且对于每个工作表（根据数组内的顺序），它会将 E 列复制到“摘要”表，从“一月”开始到 A 列（很容易被撤销）

代码

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

【讨论】：

【解决方案3】：

摘要表上 A 列中的“Jan”：

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

对于摘要表 L 列中的“Jan”：

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

减少代码（并真正提高其效率）的基本方法是摆脱所有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

【讨论】：

【解决方案4】：

所以，我添加了一个 for 循环，而且您的代码中有一些不必要的步骤。您应该避免 .select 类似的行。我希望这会奏效，请告诉我。

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

【讨论】：

很好的解决方案和建议，但请修改您的循环以充分解决问题。您需要将“Dec”工作表引用更改为基于 i 并调整边界，因为他试图合并 12 个月的数据。
我知道@zerk 我在回答时意识到了这一点！抱歉之前没有意识到，我现在正在研究如何解决工作表问题。

【解决方案5】：

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

【讨论】：