Tạo tiêu để dầu dòng theo điều kiện (1 người xem)

[HUYNHTIEN0202]

Minh đang áp dụng code tạo tiêu đề đầu dòng được 1 sheet ,nay muốn áp dụng tất cả các sheet còn lại
Nhưng khi chạy code sau thì các sheet sau điều cập nhật luôn sheet đầu
Mong các anh chị giúp đỡ

Private Sub CommandButton1_Click()
Dim Arr(), dArr(1 To 50000, 1 To 15), I As Long, J As Long, K As Long, Tem As String
Dim Sh As Worksheet
For Each Sh In Worksheets
    If Sh.Name <> "DATA" Then
Arr = Sh.Range("B8", Sh.[B65536].End(xlUp)).Resize(, 10).Value
For I = 1 To UBound(Arr, 1)
      If Arr(I, 1) = Empty Then Exit Sub
    If Arr(I, 9) <> Tem Then
        K = K + 1
        dArr(K, 1) = IIf(Arr(I, 9) = "A", "BO PHAN A", IIf(Arr(I, 9) = "B", "BO PHAN B", Arr(I, 9)))
        Tem = Arr(I, 9)
         End If
        K = K + 1
             For J = 1 To 10
                dArr(K, J) = Arr(I, J)
                 Next
                 Next
    Sh.Range("B8").Resize(K, 10) = dArr
    End If
      Next
End Sub

 

[Ba Tê]

Minh đang áp dụng code tạo tiêu đề đầu dòng được 1 sheet ,nay muốn áp dụng tất cả các sheet còn lại
Nhưng khi chạy code sau thì các sheet sau điều cập nhật luôn sheet đầu
Mong các anh chị giúp đỡ

Private Sub CommandButton1_Click()
Dim Arr(), dArr(1 To 50000, 1 To 15), I As Long, J As Long, K As Long, Tem As String
Dim Sh As Worksheet
For Each Sh In Worksheets
    If Sh.Name <> "DATA" Then
Arr = Sh.Range("B8", Sh.[B65536].End(xlUp)).Resize(, 10).Value
For I = 1 To UBound(Arr, 1)
      If Arr(I, 1) = Empty Then Exit Sub
    If Arr(I, 9) <> Tem Then
        K = K + 1
        dArr(K, 1) = IIf(Arr(I, 9) = "A", "BO PHAN A", IIf(Arr(I, 9) = "B", "BO PHAN B", Arr(I, 9)))
        Tem = Arr(I, 9)
         End If
        K = K + 1
             For J = 1 To 10
                dArr(K, J) = Arr(I, J)
                 Next
                 Next
    Sh.Range("B8").Resize(K, 10) = dArr
    End If
      Next
End Sub

Bạn thử thay bằng Sub này coi sao.

Public Sub GPE()
Dim Arr(), dArr(), I As Long, J As Long, K As Long, Tem As String
Dim Sh As Worksheet
For Each Sh In Worksheets
    If Sh.Name <> "DATA" Then
        Arr = Sh.Range("B8", Sh.[B65536].End(xlUp)).Resize(, 9).Value
        Tem = "": K = 0
        ReDim dArr(1 To UBound(Arr) * 2, 1 To 9)
        For I = 1 To UBound(Arr, 1)
        If Arr(I, 9) = "" Then Exit Sub 'Da co tieu de - Thoat'
            If Arr(I, 9) <> Tem Then
                K = K + 1: Tem = Arr(I, 9)
                dArr(K, 1) = "BO PHAN " & Tem
            End If
                K = K + 1
                For J = 1 To 9
                    dArr(K, J) = Arr(I, J)
                Next J
        Next I
        Sh.Range("B8").Resize(K, 9) = dArr
    End If
Next Sh
End Sub

 

[HUYNHTIEN0202]

Bạn thử thay bằng Sub này coi sao.

Public Sub GPE()
Dim Arr(), dArr(), I As Long, J As Long, K As Long, Tem As String
Dim Sh As Worksheet
For Each Sh In Worksheets
    If Sh.Name <> "DATA" Then
        Arr = Sh.Range("B8", Sh.[B65536].End(xlUp)).Resize(, 9).Value
        Tem = "": K = 0
        ReDim dArr(1 To UBound(Arr) * 2, 1 To 9)
        For I = 1 To UBound(Arr, 1)
        If Arr(I, 9) = "" Then Exit Sub 'Da co tieu de - Thoat'
            If Arr(I, 9) <> Tem Then
                K = K + 1: Tem = Arr(I, 9)
                dArr(K, 1) = "BO PHAN " & Tem
            End If
                K = K + 1
                For J = 1 To 9
                    dArr(K, J) = Arr(I, J)
                Next J
        Next I
        Sh.Range("B8").Resize(K, 9) = dArr
    End If
Next Sh
End Sub

Cám ơn anh rất nhiều