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

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

来源

2013-04-29 Were_cat

你用什么方法将表单复制到新文件中？ – 2013-04-29 11:43:48

对于第一本书中的每张纸，我检查名称是否与数组匹配。如果是，我使用方法.copy。 – 2013-04-29 12:01:19

将您现有的代码添加到您的问题中 – 2013-04-29 12:03:50

什么是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-29 14:49:07 Marshall

值2，一个错字？ – 2013-04-30 14:37:57

摩擦时间错误'1004'线上的应用程序定义或对象定义的错误： .cells = x – 2013-04-30 14:51:12

没有值2不是错字，它是获取单元格值的稍微更快的路径。 – Marshall 2013-04-30 15:56:39

为了保留源工作表的原始格式使用下面的：

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-30 17:41:17 Marshall

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

回答

相关问题