Macro is running very slow as source file is too large

Question

I have below code which helps me to open file copy data from that file to current workbook. it also filter the data and delete unwanted row. The problem is that source file is too large size of file is up to 30MB it contain data in range of A1:BG1018576

Once file is open the job is to copy specific column and past it also it will filter the data and delete unwanted row.

Sub Position()
    Dim b1 As Workbook, b2 As Workbook
    Dim ws As Worksheet
    Dim src As Worksheet
    Dim trg As Worksheet
    Dim Fname As String
    Dim LR As Long
    Dim LR1 As Long

    Set b1 = ThisWorkbook 
    Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")

    If Fname = "False" Then Exit Sub

    Set b2 = Workbooks.Open(Fname)
    Set b2 = ActiveWorkbook

    For Each ws In b2.Sheets
        If ws.Visible Then
            ws.Copy after:=b1.Sheets(b1.Sheets.Count)
        End If
    Next ws

    b2.Close

    Set src = ThisWorkbook.Worksheets("CR")
    Set trg = ThisWorkbook.Worksheets("Data")
    src.Range("B:B").Copy Destination:=trg.Range("E1")
    src.Range("G:G").Copy Destination:=trg.Range("D1")
    src.Range("T:T").Copy Destination:=trg.Range("F1")
    src.Range("BB:BB").Copy Destination:=trg.Range("G1")
    src.Range("BG:BG").Copy Destination:=trg.Range("H1")        
    src.Range("D:D").Copy Destination:=trg.Range("I1")        
    src.Range("F:F").Copy Destination:=trg.Range("J1")                
    src.Delete

    With Worksheets("Data") '<--| always specify full worksheet reference (change "MyWantedSheet" with your actual sheet name)
        With .Columns("D:D") '.Resize(.Cells(.Rows.Count, "B").End(xlUp).Row) '<--| refer to wanted column range down to its last non empty cell
            .AutoFilter '<--| remove possible preeeding autofilter filtering
            .AutoFilter Field:=1, Criteria1:="=" '<--| apply current filtering
                .Resize(.Parent.Cells(.Parent.Rows.Count, "E").End(xlUp).Row - 1).Offset(1).SpecialCells(xlCellTypeVisible).Rows.Delete '<--|delete visible rows other than the first ("headers") one
        End With
        .AutoFilterMode = False '<--| remove drop-down arrows
    End With

    With Worksheets("Data") '<--| always specify full worksheet reference (change "MyWantedSheet" with your actual sheet name)
        With .Columns("H:H") '.Resize(.Cells(.Rows.Count, "B").End(xlUp).Row) '<--| refer to wanted column range down to its last non empty cell
            .AutoFilter '<--| remove possible preeeding autofilter filtering
            .AutoFilter Field:=1, Criteria1:="N" '<--| apply current filtering
                .Resize(.Parent.Cells(.Parent.Rows.Count, "E").End(xlUp).Row - 1).Offset(1).SpecialCells(xlCellTypeVisible).Rows.Delete '<--|delete visible rows other than the first ("headers") one
        End With
        .AutoFilterMode = False '<--| remove drop-down arrows
    End With

    Sheets("Data").Select
    Sheets("DATA").Range("G1:G" & Sheets("DATA").UsedRange.Rows.Count).Select
    Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End sub 

it is taking too much time to process the data, is there any other method to make this process faster

Answer 1

One thing that I always to do reduce the speed of my macro is change the file extension to a binary file. You can still have macros, and it cuts the file size in half.

At the beginning of my code, I always have:

Sub GettingStarted()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
End Sub

At the end of my code, I always have:

Sub BackToNormal()
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

If you do not need your code to do calculations while it is running, you can also include

Application.Calculation = xlCalculationManual

And when you are finished, be sure to change it back to

Application.Calculation = xlCalculationAutomatic