dkomawari
06-07-2018, 12:17 AM
Hi Guys,
I am currently doing a report in which I will get the reports based on the link / path and file name I indicated in a specific cell and data should be transferred in the specific sheet I also indicated. This is needed as path is always changing depending on where the user saved the files.
The first file (File A) should be transferred to "MasterData" Sheet. This is already OK, however, the start cell is in 2nd line (A2) but should start in A1.
The second file (File B) is being transferred in "MasterData" sheet and under the data of first file. This should be transferred in the 2nd sheet.
The third file (File C) is same on what's happening in second file (File B). But this should be transferred in the 3rd sheet.
My second and third files are in TXT file, but I want it to be transferred as delimited and some columns should be in text format.
Below is currently my code:
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
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:=False
Set dataWB = ActiveWorkbook
Range(strCopyRange).Select
Selection.Copy
currentWB.Activate
Sheets("MasterData").Select
lastRow = LastRowInOneColumn(strStartCellColName)
Cells(lastRow + 1, 1).Select
Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
Application.CutCopyMode = False
dataWB.Close False
Sheets("List").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
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function
I am currently doing a report in which I will get the reports based on the link / path and file name I indicated in a specific cell and data should be transferred in the specific sheet I also indicated. This is needed as path is always changing depending on where the user saved the files.
The first file (File A) should be transferred to "MasterData" Sheet. This is already OK, however, the start cell is in 2nd line (A2) but should start in A1.
The second file (File B) is being transferred in "MasterData" sheet and under the data of first file. This should be transferred in the 2nd sheet.
The third file (File C) is same on what's happening in second file (File B). But this should be transferred in the 3rd sheet.
My second and third files are in TXT file, but I want it to be transferred as delimited and some columns should be in text format.
Below is currently my code:
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
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:=False
Set dataWB = ActiveWorkbook
Range(strCopyRange).Select
Selection.Copy
currentWB.Activate
Sheets("MasterData").Select
lastRow = LastRowInOneColumn(strStartCellColName)
Cells(lastRow + 1, 1).Select
Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
Application.CutCopyMode = False
dataWB.Close False
Sheets("List").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
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function