+ Reply to Thread
Results 1 to 1 of 1

Consolidate value from other workbook

  1. #1
    Registered User
    Join Date
    03-08-2013
    Location
    Malaysia
    MS-Off Ver
    Excel 2003
    Posts
    1

    Consolidate value from other workbook

    Hi all masters,

    I need help here.
    I wish to use a macro to auto-copy value from workbook 'Source.xls' to another workbook 'SheetsTo1Sheet-ImportConsolidationMacro.xls'.

    I need to copy below column value in 'Source.xls'
    a. Source.xls > column E8 (Transaction Value up to RM33,333.33)
    b. Source.xls > column H8 (Transaction Value up to RM1.25mil)
    c. Source.xls > column J8 (Transaction Value above RM1.25mil to RM3.33 mil)


    The macro is as below, not sure what went wrong. Need help from all the master here.
    --------------------------------------------------------------------------------------------------------------------------------------
    Sub ConsolidateRandomColumns()

    'Open a source file and copy all the data from all sheets
    'into this workbook matching the column headers in this workbook
    Dim wsData As Worksheet
    Dim wsCons As Worksheet
    Dim wbSrc As Workbook
    Dim Col As Long
    Dim NumCols As Long
    Dim ColFnd As Long
    Dim LastRow As Long
    Dim NextRow As Long
    Application.ScreenUpdating = False

    'Setup - Report sheet
    Set wsCons = ThisWorkbook.Sheets("Consolidated Data")
    'Anything to change for Range?
    NumCols = wsCons.Range("1:1").SpecialCells(xlConstants).Columns.Count
    NextRow = wsCons.Range("A" & Rows.Count).End(xlUp).Row + 1

    'Open the source data workbook
    Set wbSrc = Workbooks.Open("C:\2010\Source.xls")
    On Error Resume Next

    'Loop each sheet and collect data from matching columns
    For Each wsData In wbSrc.Worksheets
    LastRow = wsData.Cells.Find("*", wsData.Cells(Rows.Count, Columns.Count), _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Col = 1 To NumCols
    'Anything to change for Range?
    ColFnd = wsData.Range("1:1").Find(wsCons.Cells(1, Col).Text, _
    wsData.Cells(1, Columns.Count), xlValues, xlWhole, _
    SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    If ColFnd > 0 Then
    wsData.Range(wsData.Cells(2, ColFnd), wsData.Cells(LastRow, ColFnd)) _
    .Copy wsCons.Cells(NextRow, Col)
    ColFnd = 0
    End If
    Next Col
    NextRow = wsCons.Range("A" & Rows.Count).End(xlUp).Row + 1
    Next wsData

    'Cleanup
    wbSrc.Close False
    Set wsCons = Nothing
    Set wbSrc = Nothing
    Application.ScreenUpdating = True
    End Sub
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1