Alternative to activecell copy and paste

0
votes

I have a simple macro, which looks at A1, then copy and paste into a specific range into another sheet, goes back to original sheet then offsets each column, (copy and paste procedure) until column T, then this moves down 1 row and repeats, it then saves the sheet as a PDF and this process repeats about 100 times.

How can I improve the speed of this macro, I will add a Dim rng as worksheet. Then Set rng as Worksheet("Cost Gained") etc. But I'm after taking off the activecell and offset part and replacing it with ...?

The two sheets are in the same workbook which is already open when the macro is run.

Please help! 

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

Also this will help with reducing the Lines of my macro too.

Thanks for looking

1
vbaexcel
Don't use .Select, just refer to the cell directly e.g. Sheets("Cost Gained SelfBill").Range("A1"). Also, don't Copy/Paste. Set the values of the cells to what you want e.g. Range("A1").Value = Range("A2").Value – Jordan
Thanks Jordan, Some cells are filtered out, so I wasnt sure how to get around that, with Setting a value. I will take your advice, and use it for the last line of '1 Range("C6") etc. – J Junior
Here's a good SO thread on how to avoid using .Select/.Activate as well. – BruceWayne

1 Answers

0
votes

I've looked through a bit of the first half of the code (from note '8 at G9 to note '16 at G15) and figure you could clean this up with a loop to save you some time... you keep going down rows, so a For statement would work:

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

You would probably be able to do similar for some of the other items, too. In the copy part, you can use something similar to Cells(i+5,2) which describes an offset of 5 rows and allows in column 2, which will go for each row i to last i.