2016-10-25 5 views
0

Dieses Makro sieht eine Zeile, kopiert den Inhalt und fügt es in gewünschten Zellen in bestimmten Blättern.Making vba Makro effizienter

Ich möchte diesen Makrocode schneller machen, weil es zu lange dauert. Der Code läuft über etwa 7000 Zeilen.

Jede Hilfe würde geschätzt,

Heres mein Code:

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

Statt Kopieren C11 fügen Sie dann C12 dann C13 etc warum C11 nicht kopieren: C15 auf einmal? 'Bereich (" C11: C15 "). Kopieren". –

+0

Glauben Sie nicht, dass Sie jemals die Zeile 'ActiveCell.Select' benötigen, da diese bereits ausgewählt ist. –

+0

Was könnte ich anstelle von ActiveCell haben? Ich bin neu, also habe ich versucht, es so einfach wie möglich zu machen. –

Antwort

1

Sie shoul der .Select loszuwerden und Selection. eröffnen Sie bitte brauchen sie, sie verlangsamen Code und kann dazu führen, Fehler.

Beispiel:

Statt

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

Sie können

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

Ich habe versucht, die Auswahl zu entfernen. Es kommt mit Laufzeitfehler 1004. Ich markiert Activecell.offset (1, -17) .Wählen. –

+0

Wenn Sie '.Select' nicht verwenden, können Sie auch nicht mit' ActiveCell' arbeiten. Aber Sie können schreiben 'Cell (1,1) .offset (1,1)' – FatTony

0

schreiben, wie Sie keine der PasteSpecial Paste Typen (wie xlPasteValues) verwenden, dann könnten Sie verwenden Sie einfach:

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

Diese Kopien aus Bereich B1 (.Cells (1,2) - Zeile 1, Spalte 2) in A2 (.Cells (2,1) - Zeile 2, Spalte 1).

+0

auf den ersten, ich habe nur Paste, dann kam mit Fehlern, so dass ich paste special, schien dies zu arbeiten. Ich versuchte dann, xlpastevalues ​​zu verwenden, das mit Fehlern aufkam, so dass ich es gerade als pasespecial zu der Zeit gelassen habe. –

1

Gerade diese beiden Zeilen am Anfang Input_Template()

hinzufügen und diese zwei Zeilen vor dem End Sub

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 
+0

Was bedeutet die Berechnung = x1calculationManual/auto? –

+0

Es behält die Berechnungen von Excel-Formeln, bis Ihr Skript fertig ist, wodurch die Leistung erhöht wird –