Альтернатива activecell copy и paste

Question

У меня есть простой макрос, который смотрит на A1, затем копирует и вставляет в определенный диапазон в другой лист, возвращается к исходному листу, а затем смещает каждый столбец (процедура копирования и вставки) до тех пор, пока столбец T, то это перемещается вниз на 1 строку и повторяется, а затем сохраняет лист как PDF, и этот процесс повторяется примерно 100 раз.

Как я могу улучшить скорость этого макроса, я добавлю Dim rng в качестве рабочего листа. Затем установите rng как рабочий лист («Cost Aained») и т. Д. Но после того, как я снял активацию и смещенную часть и заменил ее ...?

Два листа находятся в одной книге, которая уже открыта, когда выполняется макрос.

Пожалуйста, помогите!

Sub Input_Template() 
Application.Calculation = xlCalculationManual 
Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.DisplayStatusBar = False 

Dim E26val As String 

'Go to A1 in Cost Gained sheet, look for next available cell. 
Sheets("Cost Gained SelfBill").Select 
Range("A1").Select 
ActiveCell.Offset(1, 0).Select 
Do Until ActiveCell.EntireRow.Hidden = False 
ActiveCell.Offset(1, 0).Select 
Loop 

Do 
'1 
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], ""Q-DN"")" 
'2 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("G11").Select 
ActiveSheet.PasteSpecial 
'3 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 2).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("G16,C22").Select 
ActiveSheet.PasteSpecial 
'4 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 2).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("G9,G22,G24,G26").Select 
ActiveSheet.PasteSpecial 
'5 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 2).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("G10").Select 
ActiveSheet.PasteSpecial 
'6 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 2).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("G7").Select 
ActiveSheet.PasteSpecial 
'7 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("G15").Select 
ActiveSheet.PasteSpecial 
'8 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("C9").Select 
ActiveSheet.PasteSpecial 
'9 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("C10").Select 
ActiveSheet.PasteSpecial 
'10 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("C11").Select 
ActiveSheet.PasteSpecial 
'11 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("C12").Select 
ActiveSheet.PasteSpecial 
'12 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("C13").Select 
ActiveSheet.PasteSpecial 
'13 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("C14").Select 
ActiveSheet.PasteSpecial 
'14 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("C15").Select 
ActiveSheet.PasteSpecial 
'15 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 1).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("E26").Select 
ActiveSheet.PasteSpecial 
'16 
Sheets("Cost Gained SelfBill").Select 
ActiveCell.Offset(0, 8).Select 
Selection.Copy 
Sheets("Debit Note").Select 
Range("C16").Select 
ActiveSheet.PasteSpecial 

With Sheets("Debit Note") 
E26val = .Range("E26").Value 
With .Range("G9,G22,G24,G26") 
    Select Case E26val 
     Case Is = "GBP" 
      .NumberFormat = "$#,##0.00" 
     Case Is = "EUR" 
      .NumberFormat = "[$€-2] #,##0.00" 
     Case Is = "USD" 
      .NumberFormat = "[$$-409]#,##0.00" 
     Case Else 
      'Nothing 
    End Select 'E26val 
End With '.Range("G9,G22,G24,G26") 
End With 'Sheets("Sheet1") 

Range("B22,G16").Select 
Selection.NumberFormat = "General" 
Range("G15").Select 
Selection.Style = "Hyperlink 2" 

    Sheets("Debit Note").Select 
    ChDir "P:\Feb\" 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
    "P:\Feb\" & Range("G8").Value 
    'Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ 
    :=False, OpenAfterPublish:=False 


Sheets("Cost Gained SelfBill").Select 
ActiveCell.Select 
ActiveCell.Offset(1, -26).Select 
Do Until ActiveCell.EntireRow.Hidden = False 
ActiveCell.Offset(1, 0).Select 
Loop 
Loop Until ActiveCell.Row = "20000" 

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 
Application.EnableEvents = True 
Application.DisplayStatusBar = True 

End Sub 

Также это поможет уменьшить линии моего макроса.

Спасибо для смотреть

Answer 1

Я просмотрел немного первой половины кода (с пометкой «8 в G9 отметить '16 в G15) и рисунок вы могли бы очистить это с петлей на сэкономить некоторое время ... вы продолжаете идти вниз строки, поэтому для заявления будет работать:

Dim i as Integer 

For i = 9 to 15 

    Sheets("Cost Gained Self Bill").Cells(,).Copy 'Hard to tell which cell 
    Sheets("Debit Note").Cells(i,7).PasteSpecial xlValues 'Column G = column 7 

Next i 

вы, вероятно, будете в состоянии сделать то же для некоторых других элементов, тоже. В части копии вы можете использовать что-то похожее на Cells (i + 5,2), которое описывает смещение 5 строк и позволяет в столбце 2, который будет отображаться для каждой строки i до последнего i.