0

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

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

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

还有其他方法可以继续吗？

这是我的代码：

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
4

2 回答 2

4

什么是 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
于 2013-04-29T14:49:07.450 回答
0

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

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

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

于 2013-04-30T17:41:17.340 回答