僅在另一個工作簿中保存一些工作表

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

僅在另一個工作簿中保存一些工作表

回答

相關問題