consolidating data into master sheet

[Kunal.shah]

Hi Friends,
I am trying to consolidate the data using the macro code.

Below is the link that was posted on chandoo.org

http://chandoo.org/wp/2012/04/09/consolidate-data-from-different-excel-files-vba/

In above link, The last option Copy to Location (Start cell only) is to specify where to paste the copied data and we only need to tell the start cell address, the code will automatically select the next empty cell in that column and then paste the data from that point onwards.

But when i specify Column G or any other cell, code is still selecting the column B & then paste the data from that point onwards.

kindly suggest me how to modify this code for consolidate location would start from Column G or H.

Kindly do the needful.


Regards,

Kunal Shah

 

[Marc L]

Hi !

Attach your data workbook to consolidate and your updated version
of Chandoo Consolidate Data workbook with sheet setup List mod
according to your data workbook …
​

 

[Kunal.shah]

Hi Marc,

Please find attached data workbook for your reference.

Thanks in advance.

Regards,

Kunal Shah

 

[Marc L]

Try this mod :​

Public strFileName As String
''Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

Sub GetData()
  Const strListSheet = "List"
    Dim strWhereToCopy As String, strStartCellColName As String
''    Dim strListSheet As String
 
    On Error GoTo ErrH
    Worksheets(strListSheet).Select
    Range("B2").Select
 
    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
''    Set currentWB = ActiveWorkbook
    Do While ActiveCell.Value <> ""
''
        strFileName = ActiveCell.Offset(0, 1).Text & ActiveCell.Text
        strWhereFromCopy = ActiveCell.Offset(0, 2).Value
        strCopyRange = ActiveCell.Offset(0, 3) & ":" & ActiveCell.Offset(0, 4)
        strWhereToCopy = ActiveCell.Offset(0, 5).Value
''
        strStartCellColName = ActiveCell.Offset(0, 6).Value
       
        Set dataWB = Workbooks.Open(strFileName, UpdateLinks:=False, ReadOnly:=True)
   
''        Set dataWB = ActiveWorkbook
     
''        ActiveWorkbook.Activate
''        Sheets(strWhereFromCopy).Select

''
        With Worksheets(strWhereFromCopy)
            If .FilterMode Then .ShowAllData
            .Range(strCopyRange).Copy
        End With
     
''        Range(strCopyRange).Select
''        Selection.Copy
     
''        currentWB.Activate
        ThisWorkbook.Activate
        Worksheets(strWhereToCopy).Select
''        lastRow = LastRowInOneColumn(strStartCellColName)
''        Cells(lastRow + 1, 1).Select
        With Range(strStartCellColName)
        If .Value > "" Then strStartCellColName = Cells(Rows.Count, .Column).End(xlUp)(2).Address
        End With
     
''        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Range(strStartCellColName).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False
        dataWB.Close False
        Worksheets(strListSheet).Select
        ActiveCell.Offset(1, 0).Select
    Loop
    Exit Sub
 
ErrH:
    MsgBox "It seems some file was missing. The data copy operation is not complete."
''    Exit Sub
End Sub

''Public Function LastRowInOneColumn(col)
    'Find the last used row in a Column: column A in this example
    'http://www.rondebruin.nl/last.htm
''    Dim lastRow As Long
''    With ActiveSheet
''  lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
''    End With
''    LastRowInOneColumn = lastRow
''End Function

Do you like it ? So thanks to click on bottom right Like !
​