Question

下面的代码有效，但速度不快，我确信有些方法可以简化。我不是编码员 - 我刚编了几个我找到的样本。我真的不了解粘贴方面的范围/结束/偏移部分。这就是我要做的事情： 1.在工作簿中打印前三个工作表 2.在工作簿的末尾创建三个新工作表 3.将值，格式和列宽复制并粘贴到前三个工作表的三个新工作表中。

感谢您提供的任何帮助！

Option Explicit
Option Base 1
Sub Print_copy_Current_Workbook()
'Prints the current active workbook in Excel

Sheets("Draw").PrintOut
Sheets("Calculations").PrintOut
Sheets("AIN").PrintOut

Application.ScreenUpdating = False
    Dim Tabs As Variant
    Dim I As Byte
    Tabs = Array("Draw Final", "AIN Final", "Calculations Final")
    For I = LBound(Tabs) To UBound(Tabs)
        Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1).Name = Tabs(I)
            Next I
Sheets("Draw").Range("A1:L1000").Copy
With Sheets("Draw Final").Range("iv1").End(xlToLeft).Offset(, 1)
     .PasteSpecial xlPasteFormats
     .PasteSpecial xlPasteValues
     .PasteSpecial xlPasteColumnWidths
End With
Sheets("AIN").Range("A1:L1000").Copy
With Sheets("AIN Final").Range("iv1").End(xlToLeft).Offset(, 1)
     .PasteSpecial xlPasteFormats
     .PasteSpecial xlPasteValues
     .PasteSpecial xlPasteColumnWidths
End With
Sheets("Calculations").Range("A1:L1000").Copy
With Sheets("Calculations Final").Range("iv1").End(xlToLeft).Offset(, 1)
     .PasteSpecial xlPasteFormats
     .PasteSpecial xlPasteValues
     .PasteSpecial xlPasteColumnWidths
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Answer 1

以下建议。

另外我会避免使用Option Base 1 - 它很少使用，并且在您习惯使用基于零的数组时会引起问题。

Sub Print_copy_Current_Workbook()
    Dim Tabs As Variant
    Dim I As Long

    Application.ScreenUpdating = False

    Tabs = Array("Draw", "AIN", "Calculations")

    For I = LBound(Tabs) To UBound(Tabs)

        Sheets(Tabs(I)).PrintOut
        Sheets.Add(After:=Sheets(Worksheets.Count)).Name = Tabs(I) & " Final"
        CopyPaste Sheets(Tabs(I)).Range("A1:L1000")

    Next I

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Sub CopyPaste(rng As Range)
    rng.Copy
    'this is a new sheet we're pasting to, so why not just Range("A1") ?
    With Sheets(rng.Parent.Name & " Final").Range("iv1").End(xlToLeft).Offset(, 1)
         .PasteSpecial xlPasteFormats
         .PasteSpecial xlPasteValues
         .PasteSpecial xlPasteColumnWidths
    End With

End Sub

Excel vba代码清理

1 个答案: