使vbamacros更高效

该macros查看一行,复制内容并将其粘贴到某些表单中的所需单元格中。

我想让这个macros代码更快,因为它需要很长时间。 代码循环约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 

你可以摆脱。 Selection.Selection. 你不需要他们,他们减慢代码,并可能导致错误。

例如:

代替

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

你可以写

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

只需在Input_Template()的开头添加这两行Input_Template()

 Application.Calculation = xlCalculationManual Application.ScreenUpdating = False 

并在End Sub之前添加这两行

 Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True 

由于您不使用任何PasteSpecial粘贴types(如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)。