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.
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.