Sub locdulieu()
Dim arr, arr1(1 To 500, 1 To 8)
Dim a As Long, b As Long, i As Long, j As Long, lr As Long
Dim thang As String, dk As String
Dim sh As Worksheet
With Sheets("sum")
dk = .Range("C4").Value
End With
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Sum" Then
b = 1
lr = sh.Range("C" & Rows.Count).End(xlUp).Row + 1
If lr > 9 Then
arr = sh.Range("B9:i" & lr).Value
thang = "Th" & Chr(225) & "ng " & Month(sh.Range("G2").Value)
For i = 1 To UBound(arr, 1)
If UCase(dk) = UCase(arr(i, 1)) Then
a = a + 1
arr1(a, 1) = thang
arr1(a, 7) = arr(i, 7)
arr1(a, 8) = arr(i, 8)
Do While arr(i + b, 2) <> Empty
a = a + 1
For j = 1 To 8
arr1(a, j) = arr(i + b, j)
Next j
b = b + 1
Loop
a = a + 1
Exit For
End If
Next i
End If
End If
Next
With Sheets("sum")
lr = .Range("C" & Rows.Count).End(xlUp).Row
If lr > 7 Then .Range("A8:h" & lr).Clear
If a Then
.Range("A8").Resize(a - 1, 8).Value = arr1
.Range("A8").Resize(a - 1, 8).Borders.LineStyle = 1
End If
lr = .Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To lr
If .Cells(i, "A").Value <> Empty And .Cells(i, "B").Value <> Empty Then
.Range("A" & i).Resize(b - 1, 1).Merge
.Range("A" & i).Resize(b - 1, 1).Orientation = 90
.Range("A" & i).Resize(b - 1, 1).HorizontalAlignment = xlCenter
.Range("A" & i).Resize(b - 1, 1).VerticalAlignment = xlCenter
End If
If .Cells(i, "B").Value <> Empty And IsNumeric(.Cells(i, "B")) = False Then
.Range("B" & i).Resize(, 7).Interior.Color = 6299648
.Range("B" & i).Font.ThemeColor = xlThemeColorDark1
End If
Next i
End With
End Sub
