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

我有我认为是一个简单的问题，但我真的不能让我的头周围使用循环…

我有12个工作表，分别命名为Jan，Feb，Mar …到Dec和Summary表。

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

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

 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

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

循环遍历你的`工作表（Array（“Jan”，“Feb”，….）），并且对于每个表格（根据数组内部的顺序），它将E列复制到“汇总”表中的下一个avialable列，从“1月”开始，到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

摘要表格第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 

对于摘要表中的“1月”栏目：

 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 

---

减less代码（真正提高效率）的一个基本的事情就是摆脱所有的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 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 

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