incognito
08-23-2018, 08:38 AM
Hi experts!
I am trying to import and list a range of data from multiple files kept in a Folder.
My aim is:
1. To get the data range imported to a Sheet named "DATA" in a master worksheet.
2. To be able to use the extracted data at "DATA" sheet through formula in other 3 sheets of MASTER file.
3. To get rid of the blank rows from input ranges.
4. To be able to run the code automatically once I open the MASTER worksheet.
5.
I tried the following code:
Sub Test() Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("DATA").Cells.ClearContents
Dim LastRow As Long
Dim firstRow As Long
Dim myDir As String, fn As String, n As Long, t As Long, Cell As String
Const wsName As String = "Summary of the Year"
Const myRng As String = "G77:U796"
myDir = "D:\Aircrew_Flying_Hour"
fn = Dir(myDir & "\*.xlsx")
If fn = "" Then MsgBox "No files in the folder": Exit Sub
With Range(myRng)
n = .Rows.Count: t = .Columns.Count
Cell = .Cells(1).Address(0, 0)
End With
Do While fn <> ""
With Sheets("Data").Range("a" & Rows.Count).End(xlUp)(1).Resize(n, t)
.Formula = "=if('" & myDir & "\[" & fn & "]" & wsName & "'!" & Cell & "<>""""," & _
"'" & myDir & "\[" & fn & "]" & wsName & "'!" & Cell & ","""")"
.Value = .Value
End With
fn = Dir
Loop
firstRow = Sheets("DATA").Range("A1:A" & Sheets("DATA").Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
LastRow = Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).AutoFilter Field:=1, Criteria1:="="
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If Sheets("DATA").AutoFilterMode Then Sheets("DATA").AutoFilterMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Problem is:
1. When I run the code, the code clears all previous data and import fresh data, all cells in Sheet 2,3 and 4 where I have used any type of formula linking to DATA Sheet turns into "#REF!"
2. I tried changing
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
to
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.ClearContents
Doing this I could get rid of #REF! error but now the blank rows in the range started to appear.
3. I do not know due what error the last row (with value) of my desired range from each source files are not imported. I am getting the total data range minus 1 row of information from each source files.
I tried to get a solution at mrexcel but not getting a response for long. Link below:
https://www.mrexcel.com/forum/excel-questions/1067577-hyperlinking-data-other-sheets-one-sheet-where-data-imported-macro.html
I am using Excel 2010. Can anyone please help!
I am trying to import and list a range of data from multiple files kept in a Folder.
My aim is:
1. To get the data range imported to a Sheet named "DATA" in a master worksheet.
2. To be able to use the extracted data at "DATA" sheet through formula in other 3 sheets of MASTER file.
3. To get rid of the blank rows from input ranges.
4. To be able to run the code automatically once I open the MASTER worksheet.
5.
I tried the following code:
Sub Test() Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("DATA").Cells.ClearContents
Dim LastRow As Long
Dim firstRow As Long
Dim myDir As String, fn As String, n As Long, t As Long, Cell As String
Const wsName As String = "Summary of the Year"
Const myRng As String = "G77:U796"
myDir = "D:\Aircrew_Flying_Hour"
fn = Dir(myDir & "\*.xlsx")
If fn = "" Then MsgBox "No files in the folder": Exit Sub
With Range(myRng)
n = .Rows.Count: t = .Columns.Count
Cell = .Cells(1).Address(0, 0)
End With
Do While fn <> ""
With Sheets("Data").Range("a" & Rows.Count).End(xlUp)(1).Resize(n, t)
.Formula = "=if('" & myDir & "\[" & fn & "]" & wsName & "'!" & Cell & "<>""""," & _
"'" & myDir & "\[" & fn & "]" & wsName & "'!" & Cell & ","""")"
.Value = .Value
End With
fn = Dir
Loop
firstRow = Sheets("DATA").Range("A1:A" & Sheets("DATA").Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
LastRow = Sheets("DATA").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).AutoFilter Field:=1, Criteria1:="="
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If Sheets("DATA").AutoFilterMode Then Sheets("DATA").AutoFilterMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Problem is:
1. When I run the code, the code clears all previous data and import fresh data, all cells in Sheet 2,3 and 4 where I have used any type of formula linking to DATA Sheet turns into "#REF!"
2. I tried changing
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
to
Sheets("DATA").Range("A" & firstRow & ":A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.ClearContents
Doing this I could get rid of #REF! error but now the blank rows in the range started to appear.
3. I do not know due what error the last row (with value) of my desired range from each source files are not imported. I am getting the total data range minus 1 row of information from each source files.
I tried to get a solution at mrexcel but not getting a response for long. Link below:
https://www.mrexcel.com/forum/excel-questions/1067577-hyperlinking-data-other-sheets-one-sheet-where-data-imported-macro.html
I am using Excel 2010. Can anyone please help!