Forum Discussion

PatDools's avatar
PatDools
Brass Contributor
Oct 15, 2025

Not including all columns when consolidating multiple Excel onto one tab?

Hello - I am running the following VBA code to write all rows/columns from multiple worksheets (in the same workbook) onto a 'consolidated' worksheet in that same workbook. My columns on all worksheets are the same and go out to Column 'BT'. My script runs fine, but is only writing out to Column 'BN' in my 'Consolidated' worksheet. Why is it cutting off Columns 'BM' thru 'BT'? Here is the VBA code I'm running:

Sub ConsolidateVisibleSheets()
    Dim ws As Worksheet
    Dim destSheet As Worksheet
    Dim lastRow As Long, destLastRow As Long
    Dim copyRange As Range
    
    ' Create or activate the destination sheet
    On Error Resume Next
    Set destSheet = ThisWorkbook.Sheets("Consolidated")
    If destSheet Is Nothing Then
        Set destSheet = ThisWorkbook.Sheets.Add
        destSheet.Name = "Consolidated"
    End If
    On Error GoTo 0
    destSheet.Cells.Clear ' Clear existing data on the destination sheet
    
    ' Loop through all sheets in the workbook
    For Each ws In ThisWorkbook.Sheets
        ' Skip hidden sheets and the destination sheet
        If ws.Visible = xlSheetVisible And ws.Name <> destSheet.Name Then
            ' Find the last row of data in the current sheet
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            
            ' Define the range to copy
            Set copyRange = ws.Range("A1", ws.Cells(lastRow, ws.Columns.Count).End(xlToLeft))
            
            ' Find the last row in the destination sheet
            destLastRow = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Row + 1
            
            ' Copy and paste with formatting
            copyRange.Copy
            destSheet.Cells(destLastRow, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        End If
    Next ws
    
    ' Clean up
    Application.CutCopyMode = False
    MsgBox "Data consolidated successfully!", vbInformation
End Sub

Any help is greatly appreciated!

1 Reply

  • m_tarler's avatar
    m_tarler
    Bronze Contributor

    I think you problem is this line:

                ' Define the range to copy
                Set copyRange = ws.Range("A1", ws.Cells(lastRow, ws.Columns.Count).End(xlToLeft))

    it starts at the right most column then goes to the the left but if that last row doesn't have all the data it won't be the full number of columns

    make sure the row you are on has all the columns you need (e.g. the header row) something like:

                ' Define the range to copy
                Set copyRange = ws.Range("A1", ws.Cells(1, ws.Columns.Count).End(xlToLeft))

Resources