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

以下是将工作表从一个工作簿复制到另一个工作簿的两种方法。

'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

Answer 2

您最好生成一个工作表处理子，以将工作表传递给

如下：

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中编写的流程细节：

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

将Excel工作表复制到另一个没有公式的Excel工作簿

2 个答案: