Question

此宏查看一行，复制内容并将其粘贴到特定工作表中的所需单元格中。

我想让这个宏代码更快，因为它需要太长时间。代码循环大约7000行。

任何帮助将不胜感激，

这是我的代码：

Sub Input_Template()

Application.ScreenUpdating = False

Sheets("Cost Gained").Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Do

'Qc Note
ActiveCell.Offset(0, 0).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G8,C6").Select
ActiveSheet.PasteSpecial
Range("C6").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(R[2]C[4], ""DN"")"

'Supplier Name
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G11").Select
ActiveSheet.PasteSpecial

'RTV Number
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G16,C22").Select
ActiveSheet.PasteSpecial

'Cost
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G9,G22,G24,G26,G27").Select
ActiveSheet.PasteSpecial

'Supplier Code
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G10").Select
ActiveSheet.PasteSpecial

'PO Number
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 2).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G7").Select
ActiveSheet.PasteSpecial

'Suppplier Email
Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("G15").Select
ActiveSheet.PasteSpecial

'Address
 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C9").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C10").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C11").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C12").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C13").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C14").Select
ActiveSheet.PasteSpecial

 Sheets("Cost Gained").Select
ActiveCell.Offset(0, 1).Select
Selection.Copy
Sheets("Debit Note").Select
Range("C15").Select
ActiveSheet.PasteSpecial

Range("G9").NumberFormat = "$#,##0.00"

Range("G15").Select
Selection.Style = "Hyperlink"

This contains code to add bold around an area, change font to arial size 16. 
But is very long so I have left it out.

'Save as pdf once finish one row, then save pdf in a location then continue until row 299.
    Sheets("Debit Note").Select
    ChDir "P:\Perkins\Quality\COPQ\J Benge COPQ\MACROS\Debit Notes\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "P:\Perkins\Quality\COPQ\J Benge COPQ\MACROS\Debit Notes\" & Range("G8").Value
    'Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
    :=False, OpenAfterPublish:=False

Sheets("Cost Gained").Select

ActiveCell.Select
ActiveCell.Offset(1, -17).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
Loop Until ActiveCell.Row = "299"

End Sub

Answer 1

你应该摆脱.Select和Selection.你不需要它们，它们会减慢代码并导致错误。

例如：

而不是

Sheets("Debit Note").Select
Range("G11").Select
ActiveSheet.PasteSpecial

你可以写

Sheets("Debit Note").Range("G11").PasteSpecial

Answer 2

只需在Input_Template()

的开头添加这两行

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

在End Sub

之前添加这两行

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Answer 3

由于您没有使用任何PasteSpecial粘贴类型（例如xlPasteValues），因此您可以使用：

ThisWorkbook.Worksheets("Cost Gained").Cells(1, 2).Copy _
    Destination:=ThisWorkbook.Worksheets("Debit Note").Cells(2, 1)

此范围从B1（ .Cells（1,2） - 第1行，第2列）到A2（ .cells（2,1）） - 第2行，第1列）。

使vba宏更有效率

3 个答案: