Nhờ các anh chị xem xét rút gọn công thức VBA giúp copy dữ liệu sang sheet khác

Kính gửi các anh chị.

Em có nhu cầu chuyển 1 số dữ liệu từ sheet1 sang sheet 2.
Tuy nhiên khi kiến thức có hạn nên không viết được code tối ưu
Khi chạy báo lỗi nhưng tìm được nguyên nhân
Nhờ các anh chị tối ưu giúp file kèm theo.
Các nội dung mong muốn em đã viết trong file.
Em cảm ơn ạ

Chạy code

Option Explicit
Sub XYZ()
  Dim arr(), res(), dic As Object
  Dim sRow&, sC&, i&, j&, k&, ik&, tg As Date, key$
  Const sCol& = 28 '(28-8)/2 = 10 lan trong 1 ngay
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Data")
    arr = .Range("A3", .Range("M" & Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(arr)
  ReDim res(1 To sRow, 1 To 100)
  For i = sRow To 1 Step -1
    If arr(i, 7) <> Empty Then
    tg = arr(i, 2)
    key = arr(i, 7) & "" & CLng(Int(tg))
    If dic.exists(key) = False Then
      k = k + 1
      dic.Add key, k
      res(k, 2) = key
      res(k, 3) = arr(i, 7):  res(k, 4) = arr(i, 8)
      res(k, 5) = arr(i, 9):  res(k, 6) = arr(i, 11)
      res(k, 7) = arr(i, 12):  res(k, 8) = Int(tg)
    End If
    ik = dic.Item(key)
    For j = 9 To sCol Step 2
      If res(ik, j) = Empty Then
        res(ik, j) = Format(tg, "hh:mm")
        res(ik, j + 1) = arr(i, 13)
        If j > sC Then sC = j + 1
        Exit For
      End If
    Next j
    End If
  Next i
  Application.ScreenUpdating = False
  With Sheets("KQ")
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i > 10 Then .Range("A11:A" & i).Resize(, sCol).Clear
    If k Then
      .Range("C11").Resize(k).NumberFormat = "@"
      .Range("H11").Resize(k).NumberFormat = "dd-mm-yyyy"
      .Range("A11").Resize(k, sC).Borders.LineStyle = 1
      .Range("A11").Resize(k, sC) = res
      .Range("A11").Resize(k, sC).Sort .Range("C11"), 1, Header:=xlNo
      .Range("A11") = 1
      .Range("A11").Resize(k).DataSeries
    End If
  End With
  Application.ScreenUpdating = True
End Sub

www.giaiphapexcel.com/diendan/threads/nh%E1%BB%9D-c%C3%A1c-anh-ch%E1%BB%8B-xem-x%C3%A9t-r%C3%BAt-g%E1%BB%8Dn-c%C3%B4ng-th%E1%BB%A9c-vba-gi%C3%BAp-copy-d%E1%BB%AF-li%E1%BB%87u-sang-sheet-kh%C3%A1c.161698/#post-1079937

Khóa học SprinGO phù hợp

Khoá học Trưởng phòng nhân sự

Nguồn nhân lực là một trong Tứ trụ kinh doanh của doanh nghiệp, có tác động tới sự tồn tại và phát triển bền...

Xem khóa học