• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

consolidate data ! to copy from sheet.

shajan

Member
Hi Ninjas !

I am trying to modify VBA given at http://chandoo.org/wp/2012/04/09/consolidate-data-from-different-excel-files-vba/

so as to include the sheet from which to copy.


I have added an extra column at H in "Sheet:List" to include the Sheet Name

lines marked '-------------- thus were my attempts to change without success.


-------------------------------------------------------------

Public strFileName As String

Public currentWB As Workbook

Public dataWB As Workbook

Public strCopyRange As String


'-----------------Public strCopySheet As String


Sub GetData()

Dim strWhereToCopy As String, strStartCellColName As String

Dim strListSheet As String


strListSheet = "List"


On Error GoTo ErrH

Sheets(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) & ActiveCell.Value

'-------- strCopySheet = ActiveCell.Offset(0, 6).Value

strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)

strWhereToCopy = ActiveCell.Offset(0, 4).Value

strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)


Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True

Set dataWB = ActiveWorkbook


'---------- Sheets(strCopySheet).Range(strCopyRange).Select

Selection.Copy


currentWB.Activate

Sheets(strWhereToCopy).Select

lastRow = LastRowInOneColumn(strStartCellColName)

Cells(lastRow + 1, 1).Select


Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone

Application.CutCopyMode = False

dataWB.Close False

Sheets(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

---------------------------------------------------


please help ! Thanks.
 
Hi, shajan!


The procedure to find the last row in a column or similarly the last column in a row described at rondebruin.nl website doesn't work and retrieves a 1 (one) if the whole row or column are all fulfilled with data.


Instead of that you should use code like this:

http://chandoo.org/forums/topic/vba-colour-to-rows#post-35527


I realize that those are extreme conditions, but sharpening the code isn't hard at all.


Regards!
 
Back
Top