Copy non blank rows from each workbook in a folder to current workbook under eachotha

[banker]

Hi All,

I have a number of workbooks beginning with an ?Appendix I ? aaaaaa.xls? (where aaaaaa is some random name). These workbook are in a folder that you can identify as below in my code.

What I need to do is import all workbooks that start with the name ?Appendix I?
I would like to import from a sheet named Non-Permanent Roles starting from ROW ("A6:n162")
But only import/copy NON BLANK ROWS with data in them.
All rows have formulas in them but if they do not have actual data I do not want these rows imported. Only those with physically typed data, I would like imported.
If the row has any data within this range I want it to be imported/copied to This current workbook in a sheet named Non-Permanent Roles.
This needs to loop all workbooks in the folder and do all the above and then paste the data that it copies underneath the last copied section.

I tried the following code, but I don?t know how to code all the above elements..

If anyone could help, I would be mostly appreciated.


[VBA] Sub import()
Dim fn As String
Dim DataFolder, DataFile As String
DataFolder = Range("c6")
fn = Dir(myDir & "*.xls")
Do While fn <> ""

With Workbooks.Open(DataFolder & fn)

With .Sheets("Non-Permanent Roles").Range("A6:n162")

ThisWorkbook.Sheets("Non-Permanent Roles").Range("a" & Rows.Count).End(xlUp)(2) _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
.Close False
End With

fn = Dir
Loop
End Sub[/VBA]

[Bob Phillips]

Not tested it, and you don't say what problems you are having, but does this work?

[vba]

Sub import()
Dim fn As String
Dim DataFolder As String
Dim DataFile As String
Dim LastRow As Long

DataFolder = Range("C6").Value
fn = Dir(myDir & "Append I - *.xls")
Do While fn <> ""

With Workbooks.Open(DataFolder & fn)

With .Sheets("Non-Permanent Roles").Range("A6:N162")

ThisWorkbook.Sheets("Non-Permanent Roles").Range("A" & Rows.Count).End(xlUp)(2) _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
.Close False
End With

fn = Dir

With ThisWorkbook.Sheets("Non-Permanent Roles")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1

If Application.CountIf(.Rows(i) = """") = .Columns.Count Then

.Rows(i).Delete
End If
Next i
End With
Loop
End Sub
[/vba]