PDA

View Full Version : Copy non blank rows from each workbook in a folder to current workbook under eachotha



banker
08-03-2008, 05:39 PM
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.


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

Bob Phillips
08-04-2008, 12:53 AM
Not tested it, and you don't say what problems you are having, but does this work?



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