Improving existing VBA code and removal of unwanted row

[Narasimharao Nandula]

Dear All,

I have managed to make a code for one of our local requirement and it works. I have bunch of different formula's in the row 8 of the sheet between "A:E" and "G:FD" which are connected to several independent sheets. My requirement is of copy of each formula (between "A:E" and "G:FD") till last row of Column "F". Column F data is copied from some other sheet. So that data should not get disturbed.

However there are 2 problems in the code which are defined below:

1) Code is very slow when no. of rows in the sheet are more than 200, no of rows some times go to the tune of 20,000.
2) Code creates last row with blank values. I tried my best to remove this row with the code but could not succeed.

Kindly suggest corrections and faster execution of the code.

Look forward for the advise.

best regards,
Narasimharao

Sub Copyformula()
Dim NextRow As Long
Dim Data1, Data2, Data3 As String
Data1 = "Formula1"
Data2 = "Formula2"
Data3 = "Formula3"
Dim l As Long
Dim lRow As Long
Dim Counter As Integer

Worksheets("Sheet1").Activate
ActiveSheet.Range("A9:E20000").ClearContents
ActiveSheet.Range("G9:FD20000").ClearContents

lRow = Range("F" & Rows.Count).End(xlUp).Row
Counter = 1

For l = 2 To lRow
Counter = Counter + 1

    If Range("F" & l).Value <> "" Then
        
    Worksheets("Sheet1").Range("Formula1").Copy _
    Destination:=Worksheets("Sheet1").Cells(Counter + 1, 1).Offset(0, 0)
        
    Worksheets("Sheet1").Range("Formula2").Copy _
    Destination:=Worksheets("Sheet1").Cells(Counter + 1, 7).Offset(0, 0)
    
    Worksheets("Sheet1").Range("Formula3").Copy _
    Destination:=Worksheets("Sheet1").Cells(Counter + 1, 17).Offset(0, 0)
       
    End If
Next l
    MsgBox "Done, Please proceed to Next Step"
End Sub

[AB33]

Untested.

Sub macro_11112()
Application.ScreenUpdating = 0
With Sheets("Sheet1")
   .Range("A8:E8").Resize(.Cells(.Rows.Count, "F").End(xlUp).Row, 5).FillDown
   .Range("G8:FD8").Resize(.Cells(.Rows.Count, "F").End(xlUp).Row, 160).FillDown
End With
 Application.ScreenUpdating = True
End Sub

[Narasimharao Nandula]

Hi AB33

Once again thank you for prompt reply. I could use above code. in column F data is from F8. So when i use the code, 7 additional rows are created. Bold letter portion "F" needs corrections. Could you please suggest alternatives?

Thanks again.
Narasimharao

 .Range("A8:E8").Resize(.Cells(.Rows.Count, "F").End(xlUp).Row, 5).FillDown

[Narasimharao Nandula]

Hi AB33

I have managed to correct the code. THank you once again for your support and i am very happy for your continuous support again and again. Really my knowledge is improved with your support.

Best Regards,
Narasimharao

Corrected code is as follows:

Application.ScreenUpdating = 0
    With Sheets("ProMIS Projects Financial data")
   .Range("A8:E8").Resize(.Cells(.Rows.Count, "F").End(xlUp).Row - 7, 5).FillDown
   .Range("G8:FD8").Resize(.Cells(.Rows.Count, "F").End(xlUp).Row - 7, 160).FillDown
    End With
    Application.ScreenUpdating = True

[AB33]

Narasimharao,
Well done!
Yes, I forget to deduct the first 7 rows as my rows count goes from 1 to the bottom.