Mình cần giúp đỡ về VBA coppy dữ liệu sang nhiều sheet

[Banotnt]

Mình có 1 file hồ sơ gồm hồ sơ và biên mục từng tờ trong hồ sơ
Làm sao để coppy biên mục vào phía dưới tiêu đề hồ sơ được ạ
Mong mn giúp đỡ !!

 

[HieuCD]

Mình có 1 file hồ sơ gồm hồ sơ và biên mục từng tờ trong hồ sơ
Làm sao để coppy biên mục vào phía dưới tiêu đề hồ sơ được ạ
Mong mn giúp đỡ !!

Lưu ý theo nội quy diễn đàn không được dùng từ viết tắt
Chạy code

Option Explicit
Sub ABC()
  Dim aHS(), aBM(), res(), S, dic As Object
  Dim sR&, sC&, i&, r&, ir&, k&, j&, key$, hs$
 
  With Sheet1 'Sheet Ho so
    i = .Range("A1000000").End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu!"): Exit Sub
    aHS = .Range("A2:I" & i + 1).Value2
  End With
  With Sheet2 'Sheet Bien Muc
    i = .Range("A1000000").End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu!"): Exit Sub
    aBM = .Range("A2:I" & i).Value2
  End With
  Set dic = CreateObject("scripting.dictionary")
  sR = UBound(aHS) - 1: sC = UBound(aHS, 2)
  ReDim res(1 To sR + UBound(aBM) * 2, 1 To sC)
  For i = 1 To sR
    key = aHS(i, 1)
    For j = 2 To sC
      key = key & "|" & aHS(i, j)
    Next j
    dic(key) = ""
  Next i
  For i = 1 To UBound(aBM)
    dic(aBM(i, 1)) = dic(aBM(i, 1)) & "|" & i
  Next i
  hs = aHS(1, 1)
  For i = 1 To sR
    If aHS(i, 1) <> Empty Then
    k = k + 1
    For j = 1 To sC
      res(k, j) = aHS(i, j)
    Next j
    If hs <> aHS(i + 1, 1) Then
      If dic.exists(hs) Then
        S = Split(dic(hs), "|")
        For r = 1 To UBound(S)
          ir = CLng(S(r))
          key = aBM(ir, 1)
          For j = 2 To sC
            key = key & "|" & aBM(ir, j)
          Next j
          If dic.exists(key) = False Then
            k = k + 1
            For j = 1 To sC
              res(k, j) = aBM(ir, j)
            Next j
          End If
        Next r
      End If
      hs = aHS(i + 1, 1)
    End If
    End If
  Next i
  Sheet1.Range("G2").Resize(k).NumberFormat = "@"
  Sheet1.Range("A2").Resize(k, sC) = res
  Sheet1.Range("A2").Resize(k, sC).Borders.LineStyle = 1
End Sub