在另一个工作簿中仅保存一些工作表答案

【问题标题】：Saving only some sheets in another Workbook在另一个工作簿中仅保存一些工作表
【发布时间】：2013-04-23 01:22:53
【问题描述】：

我想使用宏在新工作簿中只保存一些预定义的工作表。

我使用userform 询问新文件的名称，创建并打开它，然后将旧文件一张一张地复制并粘贴到新文件中。

这已经花费了很多时间来运行，而且随着我在工作表中复制和粘贴的数据越来越多，情况会变得更糟。

还有其他方法吗？

这是我的代码：

WB2 是旧书，Ws 是旧书中的工作表，WB 是新书，Dico_export 是包含要复制的工作表名称的字典。

For Each WS In WB2.Worksheets
    If Dico_Export.Exists(WS.Name) Then
        WB2.Worksheets(WS.Name).Copy after:=WB.Sheets(1 + i)
        If WS.Name <> "Limites LPG" Then
        tabl(i) = WS.Name
        End If
        i = i + 1
    End If
Next

【问题讨论】：

您使用什么方法将工作表复制到新文件？
对于第一本书中的每张纸，我检查名称是否与数组匹配。如果是，我使用方法 .copy 。
将现有代码添加到您的问题中
在运行宏之前尝试禁用计算、事件和屏幕更新，然后重新启用它们...如果 Excel 正在重新计算，它必须考虑所有新的可能数据

标签： vba excel

【解决方案1】：

什么是 tabl(i) 变量？此外，如果您要实现一个数组来捕获工作表数据然后复制到另一个工作簿，您的代码会运行得更快。创建一个变量来保存对新工作簿（要复制到）的引用，并将新工作表添加到新工作簿中。对于您复制的每个工作表，将新工作表添加到新书，设置名称属性等，然后将现有工作表数据添加到数组变量（使用 .Value2 属性，因为它更快）并将其复制到新工作表。 .

Dim x()
Dim WB As Workbook, WB2 As Workbook
Dim newWS As Worksheet, WS As Worksheet
Dim i As Long, r As Long, c As Long
i = 1

For Each WS In WB2.Worksheets
        If Dico_Export.Exists(WS.Name) Then
            If WS.Name <> "Limites LPG" Then
               x = WS.Range("A1:N5000").Value2 ''need to adjust range to copy
               Set newWS = WB.Worksheets.Add(After:=WB.Sheets(1 & i))    ''adjust to suit         your     situation
               With newWS
                   .Name = "" '' name the worksheet in the new book
                   For r = LBound(x, 1) To UBound(x, 1)
                    For c = LBound(x, 2) To UBound(x, 2)
                        .Cells(r, c) = x(r, c)
                    Next
                   Next
               End With
               Erase x
               Set newWS = Nothing
            '' tabl(i) = WS.Name (??)
            End If
        End If
Next

【讨论】：

Rub-time error '1004' Application-defined or Object-defined error on the line: .cells =x
No value2 不是拼写错误，它是获取单元格值的稍微快一点的路径。
我发现了问题@.Cells=x。我将编辑上面的代码来处理这个问题。
好的，它可以工作，但它不保持格式......你会如何解决这个问题？

【解决方案2】：

为了保留源工作表的原始格式，请使用以下内容：

For r = LBound(x, 1) To UBound(x, 1)
  For c = LBound(x, 2) To UBound(x, 2)
    NewWS.Rows(r).RowHeight = WS.Cells(r, c).RowHeight
    NewWS.Columns(c).ColumnWidth = WS.Cells(r, c).ColumnWidth
    With NewWS.Cells(r, c)
        .Font.Bold = WS.Cells(r, c).Font.Bold
        .Borders(xlEdgeBottom).LineStyle = WS.Cells(r, c).Borders(xlEdgeBottom).LineStyle
        .Borders(xlEdgeLeft).LineStyle = WS.Cells(r, c).Borders(xlEdgeLeft).LineStyle
        .Borders(xlEdgeRight).LineStyle = WS.Cells(r, c).Borders(xlEdgeRight).LineStyle
        .Interior.ColorIndex = WS.Cells(r, c).Interior.ColorIndex
        .Orientation = WS.Cells(r, c).Orientation
        .Font.Size = WS.Cells(r, c).Font.Size
        .HorizontalAlignment = WS.Cells(r, c).HorizontalAlignment
        .VerticalAlignment = WS.Cells(r, c).VerticalAlignment
        .MergeCells = WS.Cells(r, c).MergeCells
        .Font.FontStyle = WS.Cells(r, c).Font.FontStyle
        .Font.Name = WS.Cells(r, c).Font.Name
        .ShrinkToFit = WS.Cells(r, c).ShrinkToFit
        .NumberFormat = WS.Cells(r, c).NumberFormat
    End With
  Next
Next

这将解决大多数格式问题；根据需要添加其他单元格属性。

【讨论】：