Excel的VBA期待通過表和列範圍複製到另一個工作表

我有什麼，我認爲是一個簡單的問題，但我真的不能讓我的頭使用循環周圍...Excel的VBA期待通過表和列範圍複製到另一個工作表

我有12個工作表命名爲一月，二月，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

來源

2017-02-14 SMORF

你說**揚E欄將粘貼到彙總表列A **和但是你的代碼在摘要中將** Jan添加到了列表L **中？哪一個？？ – R3uK

試試這個：

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

來源

2017-02-14 13:12:55 BoffWx

完美地工作，謝謝BoffWx – SMORF

@BoffWx很好地處理'sSheet'工作表對象的可能錯誤 –

所以，我添加了一個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

來源

2017-02-14 12:54:40

良好的解決方案和建議，但請修改您的循環以充分解決問題。您需要將「Dec」工作表參考更改爲基於i，並調整他試圖合併12個月數據的範圍。 – Zerk

我知道@zerk我意識到這一點，就像我回答！對不起之前沒有意識到，我正在研究如何解決工作表問題。 –

有關綜述的表「Jan」的中柱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

對於「揚」，在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

來源

2017-02-14 13:04:17 R3uK

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

來源

2017-02-14 13:15:09

你可以嘗試短代碼版本。（Array（「Jan」，「Feb」，....）），並且對於每個表（根據數組內的順序），它將E列複製到下一個avialable列中「摘要」表，從「簡」開始列A（可以很容易地reveresd）

代碼

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

來源

2017-02-14 13:15:19

Excel的VBA期待通過表和列範圍複製到另一個工作表

回答

相關問題