在另一个工作簿中仅保存一些工作表
我想要使用macros来保存新的工作簿中只有一些预定义的工作表。
我使用一个用户userform来询问新文件的名称，创build并打开它，然后将表单从旧文件复制并粘贴到新文件中。
这已经花费了很多时间来运行，而且随着我的表单中越来越多的数据复制和粘贴，情况会变得更糟。
还有另外一种方法可以进行吗？
这是我的代码：
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
什么是tabl（i）variables？ 此外，如果要实现数组来捕获工作表数据，然后将其复制到另一个工作簿，则代码运行得更快。 创build一个variables以保存对新工作簿的引用（将被复制到），并将新工作表添加到新书中。 对于您复制的每个工作表，添加一个新工作表到新书，设置名称属性等，然后将现有工作表数据添加到数组variables（因为它更快使用.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
为了保留源工作表的原始格式，请使用以下内容：
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
这将解决大部分的格式问题。 根据需要添加其他单元格属性。