Question

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

我使用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

Answer 1

tabl（i）变量是什么？此外，如果您要实现一个Array来捕获工作表数据然后复制到另一个工作簿，您的代码将运行得更快。创建一个变量来保存对新工作簿（要复制到）的引用以及要添加到新书的新工作表。对于您复制的每个工作表，将新工作表添加到新书，设置名称属性等，然后将现有工作表数据添加到数组变量（使用.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

Answer 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

这将解决大部分格式问题;根据需要添加其他单元格属性。

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

2 个答案: