Question

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

我有12个名为Jan，Feb，Mar ...到12月的工作表和摘要表。

我想遍历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

Answer 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

Answer 2

您可以尝试较短代码版本。

循环遍历你的`工作表（数组（“Jan”，“2月”，......）），对于每个表格（根据数组内的顺序），它会将列E复制到下一个可用的列中“摘要“表格，从”Jan“开始到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

Answer 3

所以，我添加了一个for循环加上你的代码中有一些不必要的步骤。你应该避免。选择像线条。我希望这会有用，请告诉我。

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

＆＃34; Jan＆＃34;摘要表格中的col A：

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

＆＃34; Jan＆＃34;摘要表格中的col L：

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

Answer 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

Excel VBA查看工作表并将列范围复制到另一个工作表

5 个答案: