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
Statt Kopieren C11 fügen Sie dann C12 dann C13 etc warum C11 nicht kopieren: C15 auf einmal? 'Bereich (" C11: C15 "). Kopieren". –
Glauben Sie nicht, dass Sie jemals die Zeile 'ActiveCell.Select' benötigen, da diese bereits ausgewählt ist. –
Was könnte ich anstelle von ActiveCell haben? Ich bin neu, also habe ich versucht, es so einfach wie möglich zu machen. –