将我的每个选项卡合并到一个通用表格中

Question

Hotel Star Rating Jan-24  Feb-24  Mar-24  Apr-24  May-24  Jun-24  Jul-24  Aug-24  Sep-24  Oct-24  Nov-24  Dec-24  Jan-25  Feb-25  Mar-25  Apr-25  May-25  Jun-25  Jul-25  Aug-25  Sep-25  Oct-25  Nov-25  Dec-25

评论：

这些是每个选项卡上的列标题，从单元格 A1 到 AA1

我有 6 个选项卡，每个选项卡都有岛屿名称，每个选项卡上面都有标题，下面有数据，每个月都是房间夜数。

我想将其中每一项的信息整理到一个带有列标题的表格中，

酒店
星级评定
月
年
四分之一
岛屿名称
间夜数
评论

新创建的工作表的外观示例：

这是新工作表的示例，“英国”将是其中一个选项卡的名称

Sub ConsolidateData()
    Dim ws As Worksheet
    Dim masterWs As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Dim masterRow As Long
    Dim monthYear As String
    Dim cell As Range
    
    ' Add a new worksheet for the consolidated data
    On Error Resume Next
    Set masterWs = ThisWorkbook.Sheets("Consolidated")
    If masterWs Is Nothing Then
        Set masterWs = ThisWorkbook.Sheets.Add
        masterWs.Name = "Consolidated"
    End If
    On Error GoTo 0
    
    ' Write headers in the consolidated sheet
    masterWs.Cells.Clear
    masterWs.Range("A1:E1").Value = Array("Hotel", "Star Rating", "Month", "Year", "Total Room Nights")
    masterRow = 2 ' Start writing data from row 2
    
    ' Loop through all sheets
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> masterWs.Name Then
            ' Get the last row and column
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            
            ' Loop through rows in the current sheet
            For i = 2 To lastRow ' Start from row 2 to skip headers
                ' Loop through columns for months
                For j = 3 To lastCol ' Start from column 3 (C) to include months
                    If ws.Cells(i, j).Value <> "" Then
                        ' Extract month and year from the header
                        monthYear = ws.Cells(1, j).Value
                        
                        ' Add data to the master sheet
                        masterWs.Cells(masterRow, 1).Value = ws.Cells(i, 1).Value ' Hotel
                        masterWs.Cells(masterRow, 2).Value = ws.Cells(i, 2).Value ' Star Rating
                        masterWs.Cells(masterRow, 3).Value = Split(monthYear, "-")(0) ' Month
                        masterWs.Cells(masterRow, 4).Value = Split(monthYear, "-")(1) ' Year
                        masterWs.Cells(masterRow, 5).Value = ws.Cells(i, j).Value ' Total Room Nights
                        masterRow = masterRow + 1
                    End If
                Next j
            Next i
        End If
    Next ws
    
    MsgBox "Data consolidation completed!", vbInformation
End Sub

Answer 1

Sub ConsolidateData()
    Dim ws As Worksheet
    Dim masterWs As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long
    Dim RowCnt As Long
    Dim monthYear As String
    Dim cell As Range
    
    ' Add a new worksheet for the consolidated data
    On Error Resume Next
    Set masterWs = ThisWorkbook.Sheets("Consolidated")
    If masterWs Is Nothing Then
        Set masterWs = ThisWorkbook.Sheets.Add
        masterWs.Name = "Consolidated"
    End If
    On Error GoTo 0
    
    ' Write headers in the consolidated sheet
    masterWs.Cells.Clear
    Dim aHeader: aHeader = Array("Hotel", "Star Rating", "Month", "Year", "Quarter", "Island Name", "Total Room Nights", "Comments")
    masterWs.Range("A1:G1").Value = aHeader
    
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> masterWs.Name Then
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            RowCnt = RowCnt + lastRow * lastRow
        End If
    Next
    Dim arrRes(): ReDim arrRes(1 To RowCnt, 1 To UBound(aHeader) + 1)
    RowCnt = 1
    ' Loop through all sheets
    Dim arrData, r As Range
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> masterWs.Name Then
            ' Get the last row and column
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            Set r = ws.Range("A1", ws.Cells(lastRow, lastCol))
            arrData = r.Value
            ' Loop through rows in the current sheet
            For i = 2 To lastRow ' Start from row 2 to skip headers
                ' Loop through columns for months
                For j = 3 To lastCol ' Start from column 3 (C) to include months
                    If Len(Trim(arrData(i, j))) > 0 Then
                        ' Extract month and year from the header
                        monthYear = Format(arrData(1, j), "MMM-yyyy")
                        
                        ' Add data to the master sheet
                        arrRes(RowCnt, 1) = arrData(i, 1) ' Hotel
                        arrRes(RowCnt, 2) = arrData(i, 2) ' Star Rating
                        arrRes(RowCnt, 3) = Split(monthYear, "-")(0) ' Month
                        arrRes(RowCnt, 4) = Split(monthYear, "-")(1) ' Year
                        arrRes(RowCnt, 5) = Application.RoundUp(Month(arrData(1, j)) / 3, 0)
                        arrRes(RowCnt, 6) = ws.Name ' Island Name
                        arrRes(RowCnt, 7) = arrData(i, j) ' Total Room Nights
                        RowCnt = RowCnt + 1
                    End If
                Next j
            Next i
        End If
    Next ws
    If RowCnt > 1 Then
        masterWs.Range("A2").Resize(RowCnt - 1, UBound(aHeader)).Value = arrRes
    End If
    MsgBox "Data consolidation completed!", vbInformation
End Sub