Copy dữ liệu sang Sheet mới tốn thời gian

[elvis pham]

Cảm ơn anh chị em trên diễn đàn GPE đã quan tâm giúp đỡ.
Cảm ơn HeSanbi đã tối ưu hóa code giúp mình.
Sau khi sử dụng code của HeSanBi thì thời gian chạy code giảm đi khá nhiều.
Nói tóm tắt vấn đề mình gặp phải và hướng giải quyết như sau
Vấn đề:
Thời gian copy dữ liệu từ workbook này sang workbook khác tốn thời gian
Nguyên nhân:
Do copy nhiều dòng dữ liệu nên thời gian xử lý lâu
Bạn HeSanBi đã giải quyết vấn đề
Tối ưu hóa code giảm số dòng phải copy lại làm giảm thời gian xử lý code

Sub test_()
  Dim ti As Double, Path$, iRow&
  'Tạo folder D:\Excel\ để test
  Path = "D:\Excel\text_temp" & Format(Now, "yy-mm-dd_hh_mm") & ".xlsx"
  ti = Timer
  On Error GoTo setEvents
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  iRow = IP_XK.Range("C" & IP_XK.Rows.Count).End(xlUp).Row + 10
  Dim Arr: Arr = IP_XK.Range("A1:AT" & iRow).Value

  With Workbooks.Add
    .Sheets(1).[A1].Resize(UBound(arr), UBound(arr, 2)).Value = arr
      ' IP_XK.Range("A1:AT" & iRow).Copy .Sheets(1).[A1].Resize(UBound(arr), UBound(arr, 2))
    .SaveAs Filename:=Path, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
setEvents:
    On Error Resume Next
    .Close False
  End With
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  Debug.Print Timer - ti
  Shell "explorer.exe /select," & Path, vbNormalFocus
End Sub