Trying To Copy All Data Except Headers From All Sheet Into A Summary Sheet

  • Hello ad thank you. I am new to using VBA and have come across some issue trying to compile all data across a few sheets into a summary sheet. My data is not uniform, therefore there may be more rows on some sheets than on others, however to columns should be the same. I successfully coded acquiring the used dimensions for all the sheets, excluding the header. However I was unable to actually copy the data into my Summary Sheet. Any idea what I did wrong?

    [VBA]Function SheetsDimensions() As Variant

    Dim Dimensions(1 To 50, 1 To 50) As Variant
    Dim WS_Count As Integer

    Dim X As Integer

    Dim Ix As Integer

    Dim Jx As Integer

    Ix = InputBox("Please Enter The Starting # of OFFSET For your Rows (Ex If You have Labelled Columns Or Rows, Number from the top)")

    Jx = InputBox("Please Enter The Starting # of OFFSET For your Columns (Rare, but if you had labels on the left side)")

    WS_Count = ActiveWorkbook.Worksheets.Count

    Dim lRow As Long

    Dim lCol As Long

    Dim TotRow As Long

    Dim TotCol As Long

    lRow = 0
    lCol = 0

    For X = 1 To (WS_Count - 1)

    TotRow = lRow + TotRow
    'TotCol = lCol + TotCol

    'This Sets Up The Dimensions Of Each Individual Sheet

    lRow = ActiveWorkbook.Worksheets(X).Cells.Find(What:="*", _
    After:=Range("A1"), _
    LookAt:=xlPart, _
    LookIn:=xlFormulas, _
    SearchOrder:=xlByRows, _
    SearchDirection:=xlPrevious, _

    Dimensions(X, 1) = lRow - Ix

    lCol = ActiveWorkbook.Worksheets(X).Cells.Find(What:="*", _
    After:=Range("A1"), _
    LookAt:=xlPart, _
    LookIn:=xlFormulas, _
    SearchOrder:=xlByColumns, _
    SearchDirection:=xlPrevious, _

    Dimensions(X, 2) = lCol - Jx

    'Now I Am Going to Paste Each Of These Areas In The Final Sheet (Should Be Summary Sheet)

    Dim i As Integer, j As Integer

    For i = Ix To lRow

    For j = Jx To lCol
    Dim Act As Integer
    Act = i + TotRow + 1

    ActiveWorkbook.Worksheets(WS_Count).Cells(Act, j) = ActiveWorkbook.Worksheets(X).Cells(i, j)

    Next j

    Next i

    Next X

    Dim k As Integer, l As Integer

    ' A Sample Test to See if dimensions were properly acquired

    For k = 1 To 10
    For l = 1 To 2
    Cells(k, l).Value = Dimensions(k, l)
    Next l
    Next k

    SheetsDimensions = Dimensions

    End Function

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!