This macro pulls in two workbooks, one being a template with saved formulas already, and the other containing data with thousands of rows...I need to increase the speed because the process takes more than 15 minutes.
Sub WbtoWb4()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set Wb1 = Workbooks.Open("")
Set Wb2 = Workbooks.Open("")
Wb1.Sheets("CDGL Data").Copy After:=Wb2.Sheets("STS")
Wb1.Close False
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Sheets("CDGL Data").Select
Range("AQ:BB").EntireColumn.Delete
Range("A1").AutoFilter Field:=32, Criteria1:=Sheets("DataSources").Range("B4").Value
ActiveSheet.UsedRange.Offset(1, 0).SpecialCells _
(xlCellTypeVisible).Copy
Sheets("CDGL").Select
Range("B2").PasteSpecial Paste:=xlPasteValues
With Sheets("CDGL")
rows_c1 = .Cells(Rows.Count, "G").End(xlUp).Row
Sheets("Duplicate Check").Range("A1:C" & rows_c1).Value = Sheets("CDGL").Range("H2:J" & rows_c1).Value
rows_c2 = .Cells(Rows.Count, "K").End(xlUp).Row
Sheets("Duplicate Check").Range("D1:G" & rows_c2).Value = Sheets("CDGL").Range("L2:O" & rows_c2).Value
rows_c3 = .Cells(Rows.Count, "AI").End(xlUp).Row
Sheets("Duplicate Check").Range("H1:H" & rows_c3).Value = Sheets("CDGL").Range("AJ2:AJ" & rows_c3).Value
End With
Sheets("Duplicate Check").Select
Set rng = Range("A1", Range("H1").End(xlDown))
rng.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8), Header:=xlNo
With Sheets("CDGL")
Sheets("Rec").Range("B6").Resize(.Cells(.Rows.Count, "G").End(xlUp).Row - 1, 3).Value = Sheets("Duplicate Check").Range("A1:C" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
Sheets("Rec").Range("E6").Resize(.Cells(.Rows.Count, "D").End(xlUp).Row - 1, 4).Value = Sheets("Duplicate Check").Range("D1:G" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
Sheets("Rec").Range("I6").Resize(.Cells(.Rows.Count, "H").End(xlUp).Row - 1, 1).Value = Sheets("Duplicate Check").Range("H1:H" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
Application.DisplayAlerts = False
Sheets("Duplicate Check").Delete
ActiveWorkbook.SaveAs Filename:=""
ActiveWorkbook.Close
End Sub