VBA立即複製粘貼多個表格

Question

我有一個宏用於將表格數組複製到新的工作簿中，然後將粘貼值複製到表格以保存新副本。只有這樣，我才能弄清楚如何做到這一點，就是選擇，複製和粘貼每張單頁，是否有辦法用較少的代碼完成多張表單？

Set Name = Sheets("TOTAL STO").Range("file.name") 
Sheets(Array("TOTAL STO", "TOTAL STO - OLD LOGIC", "OWN BUY STO", "CONSIGNMENT STO")).Select 
Sheets(Array("TOTAL STO", "TOTAL STO - OLD LOGIC", "OWN BUY STO", "CONSIGNMENT STO")).Copy 

Set NewWB = ActiveWorkbook 
NewWB.Sheets("TOTAL STO").Cells.Copy 
NewWB.Sheets("TOTAL STO").Range("A1").PasteSpecial Paste:=xlValues 
NewWB.Sheets("TOTAL STO - OLD LOGIC").Cells.Copy 
NewWB.Sheets("TOTAL STO - OLD LOGIC").Range("A1").PasteSpecial Paste:=xlValues 
NewWB.Sheets("OWN BUY STO").Cells.Copy 
NewWB.Sheets("OWN BUY STO").Range("A1").PasteSpecial Paste:=xlValues 
NewWB.Sheets("CONSIGNMENT STO").Cells.Copy 
NewWB.Sheets("CONSIGNMENT STO").Range("A1").PasteSpecial Paste:=xlValues 

Answer 1

以下是實現此任務的代碼。我假設你不想複製原始Excel文件中的所有工作表，但只能選擇那些（下面的代碼允許你定義要複製的工作表的名稱）。

我已經添加了對大多數行的註釋，以幫助您瞭解代碼中發生了什麼。

---

Public Sub copySheets() 
    Dim wkb As Excel.Workbook 
    Dim newWkb As Excel.Workbook 
    Dim wks As Excel.Worksheet 
    Dim newWks As Excel.Worksheet 
    Dim sheets As Variant 
    Dim varName As Variant 
    '------------------------------------------------------------ 


    'Define the names of worksheets to be copied. 
    sheets = VBA.Array("TOTAL STO", "TOTAL STO - OLD LOGIC", "OWN BUY STO", "CONSIGNMENT STO") 


    'Create reference to the current Excel workbook and to the destination workbook. 
    Set wkb = Excel.ThisWorkbook 
    Set newWkb = Excel.Workbooks.Add 


    For Each varName In sheets 

     'Clear reference to the [wks] variable. 
     Set wks = Nothing 

     'Check if there is a worksheet with such name. 
     On Error Resume Next 
     Set wks = wkb.Worksheets(VBA.CStr(varName)) 
     On Error GoTo 0 


     'If worksheet with such name is not found, those instructions are skipped. 
     If Not wks Is Nothing Then 

      'Copy this worksheet to a new workbook. 
      Call wks.Copy(newWkb.Worksheets(1)) 

      'Get the reference to the copy of this worksheet and paste 
      'all its content as values. 
      Set newWks = newWkb.Worksheets(wks.Name) 
      With newWks 
       Call .Cells.Copy 
       Call .Range("A1").PasteSpecial(Paste:=xlValues) 
      End With 

     End If 

    Next varName 

End Sub