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, _
    MatchCase:=False).Row

    Dimensions(X, 1) = lRow - Ix

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

    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
    [/VBA]

Participate now!

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