I need to consolidate multiple columns- macro

jonnynomates Posts 1 Registration date Monday April 5, 2010 Status Member Last seen April 5, 2010 - Apr 5, 2010 at 09:35 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Apr 5, 2010 at 05:37 PM
I am trying to write a macro so that I can combine data from several worksheets,
the data is contained in different columns in each worksheet but each column does have the same header name known as record date position

I want to consolidate these onto 1 overall reconciliation sheet so that all of the data from each sheet under "record date position" appears in the same column, and the source of
each position is displayed in an adjacent column.

I would also like to the macro to split the breakdown out, eg the first set of data would come from "worksheet" A , the second from "worksheet B" and so forth

any ideas?

1 response

rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Apr 5, 2010 at 05:37 PM
1. The consolidated column will not exceed the excel row limitation

Sub consolidate()
Dim lMaxRows As Long
Dim lRowBeanCounter As Long
Dim Sheet As Variant
Dim sLookForColumn As String
Dim iTargetColumn As Integer
Dim iMaxCols As Integer
Dim sRecSheet As String

    sLookForColumn = "Record Date Position"
    sRecSheet = "Reconciliation"
    On Error Resume Next
    On Error GoTo 0
    ActiveSheet.Name = sRecSheet
    Cells(1, "A") = sLookForColumn
    Cells(1, "B") = "From Sheet"
    lRowBeanCounter = 1
    For Each Sheet In Sheets
        If Sheet.Name = sRecSheet Then GoTo Next_Sheet
        iTargetColumn = 0
        On Error Resume Next
            iTargetColumn = Application.WorksheetFunction.Match(sLookForColumn, Range(Cells(1, "A"), Cells(1, Columns.Count)), 0)
        On Error GoTo 0
        If (iTargetColumn > 0) Then
            lMaxRows = Cells(Rows.Count, iTargetColumn).End(xlUp).Row
            If (lMaxRows > 1) Then
                lRowBeanCounter = lRowBeanCounter + 1
                Range(Cells(2, iTargetColumn), Cells(lMaxRows, iTargetColumn)).Select
                Cells(lRowBeanCounter, "A").Select
                ActiveSheet.PasteSpecial xlValue
                lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
                Range(Cells(lRowBeanCounter, "B"), Cells((lMaxRows), "B")).Value = Sheet.Name
                lRowBeanCounter = lMaxRows
            End If
        End If
        Next Sheet
End Sub