將Excel工作表複製到另一個不含公式的Excel工作簿中

Question

我使用此VBA代碼覆蓋了我所有的工作簿，包括數據透視表和公式轉換爲值。

Option Explicit 
Sub Copia() 
    Dim ws As Worksheet, pvt As PivotTable, aWs As Worksheet, lst As ListObject 

    Set aWs = ActiveWorkbook.ActiveSheet 
    For Each ws In ActiveWorkbook.Worksheets 
     With ws 
      For Each pvt In ws.PivotTables 
       With pvt.TableRange2 
        .Copy 
        .PasteSpecial xlPasteValues 
        .PasteSpecial xlPasteFormats 
       End With 
      Next pvt 
      For Each lst In .ListObjects 
       If Not lst.AutoFilter Is Nothing Then lst.Range.AutoFilter 
      Next 
      If .FilterMode Then .ShowAllData 
      If .AutoFilterMode Then .AutoFilter.ShowAllData 
      .UsedRange.Value = .UsedRange.Value 
      .Activate: .Cells(1, 1).Select 
     End With 
    Next 
    aWs.Activate 
    Application.CutCopyMode = False 

    End Sub 

我該如何適應它才能將活動工作表或特定工作表複製到新工作簿中？

謝謝！

MD

Answer 1

你最好生成一個工作表處理子到工作表傳遞給

喜歡如下：

Option Explicit  

Sub CopiaWS(ws As Worksheet) 
    Dim pvt As PivotTable, aWs As Worksheet, lst As ListObject 

    Set aWs = ActiveWorkbook.ActiveSheet 
    With ws 
     For Each pvt In ws.PivotTables 
      With pvt.TableRange2 
       .Copy 
       .PasteSpecial xlPasteValues 
       .PasteSpecial xlPasteFormats 
       Application.CutCopyMode = False 
      End With 
     Next pvt 
     For Each lst In .ListObjects 
      If Not lst.AutoFilter Is Nothing Then lst.Range.AutoFilter 
     Next 
     If .FilterMode Then .ShowAllData 
     If .AutoFilterMode Then .AutoFilter.ShowAllData 
     .UsedRange.Value = .UsedRange.Value 
     .Activate: .Cells(1, 1).Select 
    End With 
    aWs.Activate 
End Sub 

這種方式，你已經分居代碼從而處理收到的具體任務：

• 整潔主代碼變量不需要主任務

• 使代碼更易於維護和調試的

其實你現在可以有你的主代碼集中在處理一個工作表或單一的一個，沒有你編碼離開的過程細節令人擔憂在一個已經（希望）穩定和強大的子：

Sub Main() 

    ' other "main" code 

    CopiaWS Worksheets("MySheetName") '<--| process a single worksheet 

    ' other "main" code 

End Sub 


Sub MainAll() 
    Dim ws As Worksheet 

    ' other "main" code 

    For Each ws In ActiveWorkbook.Worksheets 
     CopiaWS ws '<--| process current loop worksheet 
    Next ws 

    ' other "main" code 

End Sub 

Answer 2

以下是將工作表從一個工作表複製到另一個工作表的兩種方法。

'Copy a worksheet "Sheet1" from workbook "Book1" to "Book2." 
'Concise 
Workbooks("Book1.xlsx").Sheets("Sheet1").Copy Before:=Workbooks("Book2").Sheets(1) 

'As a standalone sub 
Sub CopySheetFromBook1ToBook2(shtName As String, wb1Name As String, wb2Name As String) 

    Dim wb1 As Excel.Workbook 
    Dim wb2 As Excel.Workbook 

    ' Open workbooks 
    Set wb1 = Workbooks.Open(wb1Name) ' or Set wb1 = ActiveWorkbook 
    Set wb2 = Workbooks.Open(wb2Name) 

    ' Coy shtName from wb1 to wb2 
    wb1.Sheets(shtName).Copy Before:=wb2.Sheets(1) 

End Sub