Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange 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
GetFileNames
Do While ActiveCell.Value <> ""
strFileName = ActiveCell.Offset(0, 1) & ActiveCell.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
Range(strCopyRange).Select
sbUnMergeRange
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
Worksheets(ActiveSheet.Index + 1).Select
MoveData
Rows(1).EntireRow.Delete
Rows(1).EntireRow.Delete
Rows(1).EntireRow.Delete
Rows(1).EntireRow.Delete
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
Sub GetFileNames()
Dim sPath As String
Dim sFile As String
Dim iRow As Integer
Dim iCol As Integer
Dim splitFile As Variant
'specify directory to use - must end in "\"
sPath = "U:\Srikanth\PCM\Charges\Next\"
iRow = 1
sFile = Dir(sPath)
Do While sFile <> ""
iRow = iRow + 1
splitFile = Split(sFile, "-")
For iCol = 0 To UBound(splitFile)
Sheet1.Cells(iRow, iCol + 2) = splitFile(iCol)
Next iCol
sFile = Dir ' Get next filename
Loop
End Sub
Sub sbUnMergeRange()
Range("A1:O1000").UnMerge
End Sub
Sub MoveData()
Dim rng As Range
Application.ScreenUpdating = False
On Error Resume Next
Set rng = [J:J].SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
rng.FormulaR1C1 = "=IF(RC[-1]="""","""",RC[-1])"
[J:J] = [J:J].Value
End If
rng.Offset(0, -1).ClearContents
End Sub
