Untitled

Sub ConsolidateData()
    Dim wsSummary As Worksheet
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim folderPath As String
    Dim fileName As String
    Dim filePath As String
    Dim monthYear As String
    Dim sheetName As String
    Dim colOffset As Integer
    Dim i As Integer
    
    ' Đặt tên sheet tổng hợp
    Set wsSummary = ThisWorkbook.Sheets(1)
    wsSummary.Cells.Clear
    
    ' Đặt đường dẫn thư mục chứa các file Excel
    folderPath = "C:\Users\User\Desktop\test\" ' Thay đổi đường dẫn nếu cần
    
    ' Tiêu đề cột cho mỗi tháng
    Dim headers() As String
    headers = Split("Xa Tram,Ma,So KH,So HD,Tieu Thu,Cong Tien,T.thue GTGT,Tong Tien", ",")
    
    ' Điền tiêu đề cho tất cả các tháng từ 1 đến 12
    For i = 1 To 12
        colOffset = (i - 1) * (UBound(headers) + 2) + 1 ' Cách nhau 1 cột
        Dim j As Integer
        For j = LBound(headers) To UBound(headers)
            With wsSummary.Cells(1, colOffset + j)
                .Value = headers(j) & " Tháng " & i
                .Font.Bold = True
                .Font.Name = "Times New Roman"
                .Font.Size = 12
            End With
        Next j
        
        ' Tô màu xám cho cột trống giữa các tháng
        wsSummary.Columns(colOffset + UBound(headers) + 1).Interior.Color = RGB(217, 217, 217)
    Next i
    
    ' Lấy danh sách các file trong thư mục
    fileName = Dir(folderPath & "*.xlsx")
    
    Do While fileName <> ""
        ' Mở file Excel
        filePath = folderPath & fileName
        Set wb = Workbooks.Open(filePath)
        
        ' Lấy thông tin tháng và năm từ tên file
        monthYear = Mid(fileName, InStr(fileName, "ky ") + 3, 6)
        sheetName = "tk" & monthYear
        
        ' Kiểm tra xem sheet có tồn tại không
        On Error Resume Next
        Set ws = wb.Sheets(sheetName)
        On Error GoTo 0
        
        If Not ws Is Nothing Then
            ' Xác định vị trí cột cho tháng tương ứng
            i = CInt(Left(monthYear, 2)) ' Tháng
            colOffset = (i - 1) * (UBound(headers) + 2) + 1
            
            ' Sao chép dữ liệu từ file
            lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
            If lastRow > 1 Then
                ws.Range(ws.Cells(2, 2), ws.Cells(lastRow, 9)).Copy
                wsSummary.Cells(2, colOffset).PasteSpecial Paste:=xlPasteValues
            End If
        End If
        
        ' Đóng file Excel
        wb.Close SaveChanges:=False
        
        ' Lấy file tiếp theo
        fileName = Dir
    Loop
    
    ' Định dạng font chữ toàn bộ bảng tổng hợp
    With wsSummary.Cells
        .Font.Name = "Times New Roman"
        .Font.Size = 12
    End With
    
    ' Đặt viền cho toàn bộ bảng có dữ liệu
    lastRow = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row
    lastCol = wsSummary.Cells(1, wsSummary.Columns.Count).End(xlToLeft).Column
    
    If lastRow > 1 And lastCol > 1 Then
        With wsSummary.Range(wsSummary.Cells(1, 1), wsSummary.Cells(lastRow, lastCol))
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        End With
    End If
    
    ' Định dạng số kiểu comma style và bỏ .00
    For i = 2 To lastCol Step UBound(headers) + 2
        With wsSummary.Range(wsSummary.Cells(2, i), wsSummary.Cells(lastRow, i + UBound(headers)))
            .NumberFormat = "#,##0"
        End With
    Next i
    
    MsgBox "Dữ liệu đã được tổng hợp và định dạng thành công!"
End Sub