'Copy Loop from 1 Sheet to Multiple Sheet

I am able to achieve my results, but wanted to optimize my code further. Currently, for 15 projects, it takes 25 seconds. But I am expecting projects to be increased to 2000 which would take 30 minutes to execute this code. How can I further optimize this code.

Project_and_capex_costs = This sheet holds project details in each row DC_Price_calc = This is where data is copied from above sheet and also Goal seek calculation is performed DC_Price_table = This is where project data is copied from 1st sheet and also Goal seek is copied from DC_price_calc sheet Revenue_forecast_table = This sheet data is copied from DC_Price_calc Interest_forecast_table = This sheet data is copied from DC_Price_calc

The entire process above is repeated for each Project line by line

Sub Process_Price_Revenue()

Dim i As Long
Dim n As Long: n = 5
Dim wsData As Worksheet, wsCalcAndOutput As Worksheet, wsTemp As Worksheet 'specify each type
Dim LR As Long

With Worksheets("Project_and_capex_costs")
   LR = .Range("E" & Rows.Count).End(xlUp).Row
   For i = 10 To LR
        If .Cells(i, 5) <> "" Then
            Range(.Cells(i, "E"), Cells(i, "E")).Copy 'Project ID
            Worksheets("DC_price_calc").Cells(8, "B").PasteSpecial xlValues
            Range(.Cells(i, "F"), Cells(i, "F")).Copy 'Project Name
            Worksheets("DC_price_calc").Cells(9, "B").PasteSpecial xlValues
            Range(.Cells(i, "BL"), Cells(i, "BL")).Copy 'Funding Area
            Worksheets("DC_price_calc").Cells(16, "A").PasteSpecial xlValues
            Range(.Cells(i, "Q"), Cells(i, "Q")).Copy 'Capacity
            Worksheets("DC_price_calc").Cells(16, "B").PasteSpecial xlValues
            Range(.Cells(i, "DV"), Cells(i, "DV")).Copy 'LTP Calc Flag
            Worksheets("DC_price_calc").Cells(7, "D").PasteSpecial xlValues
            Range(.Cells(i, "BP"), Cells(i, "DC")).Copy 'CAPEX Costs
            Worksheets("DC_price_calc").Cells(20, "D").PasteSpecial xlValues
                    
            GoalSeekV1
            
            Range(.Cells(i, "E"), Cells(i, "E")).Copy 'Project ID
            Worksheets("DC_Price_table").Cells(n, "A").PasteSpecial xlValues
            Range(.Cells(i, "F"), Cells(i, "F")).Copy 'Project Name
            Worksheets("DC_Price_table").Cells(n, "B").PasteSpecial xlValues
            Range(.Cells(i, "BL"), Cells(i, "BL")).Copy 'Funding Area
            Worksheets("DC_Price_table").Cells(n, "C").PasteSpecial xlValues
            Range(.Cells(i, "Q"), Cells(i, "Q")).Copy 'Capacity
            Worksheets("DC_Price_table").Cells(n, "D").PasteSpecial xlValues
            Range(.Cells(i, "DV"), Cells(i, "DV")).Copy 'LTP Calc Flag
            Worksheets("DC_Price_table").Cells(n, "E").PasteSpecial xlValues
            Range("DC_Price").Copy
            Worksheets("DC_Price_table").Cells(n, "F").PasteSpecial xlValues
            
            Range(.Cells(i, "E"), Cells(i, "E")).Copy 'Project ID
            Worksheets("Revenue_forecast_table").Cells(n, "A").PasteSpecial xlValues
            Range(.Cells(i, "F"), Cells(i, "F")).Copy 'Project Name
            Worksheets("Revenue_forecast_table").Cells(n, "B").PasteSpecial xlValues
            Range(.Cells(i, "BL"), Cells(i, "BL")).Copy 'Funding Area
            Worksheets("Revenue_forecast_table").Cells(n, "C").PasteSpecial xlValues
            Range(.Cells(i, "Q"), Cells(i, "Q")).Copy 'Capacity
            Worksheets("Revenue_forecast_table").Cells(n, "D").PasteSpecial xlValues
            Range("DC_revenue_forecast").Copy 'DC Revenue Forecast
            Worksheets("Revenue_forecast_table").Cells(n, "E").PasteSpecial xlValues
            
            Range(.Cells(i, "E"), Cells(i, "E")).Copy 'Project ID
            Worksheets("Interest_forecast_table").Cells(n, "A").PasteSpecial xlValues
            Range(.Cells(i, "F"), Cells(i, "F")).Copy 'Project Name
            Worksheets("Interest_forecast_table").Cells(n, "B").PasteSpecial xlValues
            Range(.Cells(i, "BL"), Cells(i, "BL")).Copy 'Funding Area
            Worksheets("Interest_forecast_table").Cells(n, "C").PasteSpecial xlValues
            Range(.Cells(i, "Q"), Cells(i, "Q")).Copy 'Capacity
            Worksheets("Interest_forecast_table").Cells(n, "D").PasteSpecial xlValues
            Range("Interest_cost_forecast").Copy 'Interest Cost Forecast
            Worksheets("Interest_forecast_table").Cells(n, "E").PasteSpecial xlValues
            
            
            n = n + 1 'update so that we don't overwrite next time
        End If
    Next
End With

End Sub


Sub GoalSeekV1()

    Dim rngStartGoal As Range
    Set rngStartGoal = Range("DC_price_calc!$AQ$31")
    
    Dim rngStartInput As Range
    Set rngStartInput = Range("DC_Price")
    
    rngStartGoal.GoalSeek Goal:=0, ChangingCell:=rngStartInput
    
End Sub


Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source