I need to consolidate multiple columns- macro Closed

Question

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?

rizvisa1 · Answer

Assumptions
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
    Sheets(sRecSheet).Delete
    On Error GoTo 0
    
    Sheets.Add
    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
        
        Sheet.Select
        
        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
                
                Selection.Copy
                
                Sheets(sRecSheet).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:
        
        Next Sheet
    
    
End Sub

I need to consolidate multiple columns- macro

1 response

Similar discussions

Subscribe To Our Newsletter!