[英]Excel VBA look through sheets and copy column range to another sheet
我认为这是一个简单的问题,但我真的无法理解使用循环......
我有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
尝试这个:
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
您可以尝试更短的代码版本。
循环遍历你的`工作表(数组(“Jan”,“二月”,......)),并为每个表格(根据数组内的顺序),它将列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
所以,我添加了一个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
对于摘要表中的col 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
对于摘要表中的col 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
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.