2016-03-16 3 views
-1

Код ниже работает, но не быстро, и я уверен, что есть способы, которые он мог бы упростить. Я не кодер - я только что собрал несколько образцов, которые я нашел. Я действительно не понимаю фрагменты диапазона/конца/смещения для аспекта вставки. Вот что я пытаюсь сделать: 1. Распечатайте первые три листа в книге 2. Создайте три новых листа в конце рабочей книги. 3. скопируйте и вставьте значения, форматы и ширины столбцов в три новых рабочие листы из первых трех.Excel vba code clean

Спасибо за любую помощь, которую вы можете предоставить!

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 
+0

Возможный кандидат на [Обзор кода] (https://codereview.stackexchange.com/) при условии, что код работает, как говорит OP. –

ответ

0

Предложение ниже.

Кроме того, я бы избегал 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