简体   繁体   English

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

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

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. 我有12个名为Jan,Feb,Mar ...到12月的工作表和摘要表。

I would like to loop through the 12 sheets and copy Column E from each tab and paste them in to the Summary sheet. 我想遍历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.

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

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

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) 循环遍历你的`工作表(数组(“Jan”,“二月”,......)),并为每个表格(根据数组内的顺序),它将列E复制到“摘要”表格中的下一个可通过的列,从“Jan”开始到A列(很容易被尊重)

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

So, I added a for loop plus there were some unnecesarry steps in your code. 所以,我添加了一个for循环加上你的代码中有一些不必要的步骤。 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

For "Jan" in col A on the Summary's sheet : 对于摘要表中的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

For "Jan" in col L on the Summary's sheet : 对于摘要表中的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

A basic thing to do to reduce code (and really improve its efficiency), is to get rid of all Select : 减少代码(并真正提高其效率)的基本要点是摆脱所有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.

相关问题 来自另一张工作表的Excel VBA范围副本 - Excel VBA range copy from another sheet 试图将特定范围从工作簿中的许多工作表复制到另一个工作簿中的一个工作表 vba excel? - Trying to copy specific range from many sheets in workbook to one sheet in another workbook vba excel? 循环遍历工作表以将特定范围内的值复制到另一张工作表 - looping through sheets to copy value in a certain range to another sheet Excel VBA-IF / AND问题-如果两列中的值在单独的工作表上匹配,则将一个工作表中的值复制到另一列中的值 - Excel VBA - IF/AND Issue - If values from two columns match on separate sheets, copy a value from one sheet to another in another column Excel Vba将列中的数据范围复制到另一个工作表 - Excel Vba to copy a range of data in columns to another sheet excel vba 范围从一张纸复制到另一张纸(错误 1004) - excel vba range copy from one sheet to another (error 1004) Excel VBA-将范围从一个工作表粘贴复制到工作簿中的某些工作表之后的所有工作表 - Excel VBA - Copy range from one sheet paste to all sheets after certain sheet in workbook VBA Excel复制到另一张表 - vba excel copy to another sheet VBA Excel查找工作表名称,如果“选项卡”已“开始”,则循环浏览这些工作表 - VBA Excel Look up sheet name, IF tab has 'started' then loop through these sheets VBA - 根据汇总 Excel 表格上的条件,将工作簿中的不同模板工作表复制到另一个工作簿的多张工作表中 - VBA - copy different template sheets from a workbook, into multiple sheets of another workbook based on criteria on a summary excel sheet
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM