Lấy tên tiêu đề thì còn hiểu
Public Sub LayTieuDe()
Dim Ws As Worksheet, Arr(), dArr(1 To 10000, 1 To 2)
Dim J As Long, K As Long, N As Long, WsName As String
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Menu" Then
WsName = Ws.Name
N = Ws.Range("XFD1").End(xlToLeft).Column
If N = 1 Then N = N + 1
Arr = Ws.Range("A1").Resize(, N).Value
For J = 1 To N
If Arr(1, J) <> Empty Then
K = K + 1
dArr(K, 1) = WsName
dArr(K, 2) = Arr(1, J)
End If
Next J
End If
Next Ws
Sheets("Menu").Range("A2:B10000").ClearContents
Sheets("Menu").Range("A2:B2").Resize(K) = dArr
End Sub
chắc là sửa theo số thứ tự của sheets bác à làm phát cho nó loạn luôn
Dạ ví dụ tiêu đề 01 >> tên mới của sheet Du lieu 01 được thay ở tiêu đề luôn anh ạ của sheet du lieu 01
Bạn sửa lại bài #1 (chữ màu đỏ) cho rõ lại.
Viết thí thí như vầy xem sao:
Public Sub SuaTieuDe()
Dim Ws As Worksheet, sArr(), TieuDe(), WsName As String
Dim I As Long, J As Long, N As Long, R As Long
sArr = Sheets("Menu").Range("A2", Sheets("Menu").Range("A2").End(xlDown)).Resize(, 3).Value
R = UBound(sArr)
For I = 1 To R
If sArr(I, 1) <> WsName Then
WsName = sArr(I, 1)
J = 0
ReDim TieuDe(1 To 1, 1 To 100)
For N = I To R
If sArr(N, 1) = WsName Then
J = J + 1
If sArr(N, 3) <> Empty Then
TieuDe(1, J) = sArr(N, 3)
Else
TieuDe(1, J) = sArr(N, 2)
End If
Else
I = N - 1
Exit For
End If
Next N
Sheets(WsName).Range("A1").Resize(, J) = TieuDe
End If
Next I
End SubThank anh ạ. Đúng ý em rồi ạ
