Sub ConsolidatRows()

Dim sName As String
Dim sh As Worksheet , sPath as String
Dim dest As Range, bk As Workbook
Dim rng as Range

sPath = "D:\Documents and Settings\dk" _
"\Desktop\Consolidation_AR_test_files\"
sName = Dir(sPath & "*.xls")
Do While sName < ""
Set bk = Workbooks.Open(sPath & sName)
Set sh = bk.Worksheets("Analysis")
Set dest = ThisWorkbook.Worksheets(1).Cells(rows.count,1).end (xlup)(2)
set rng = sh.Range(sh.Cells(1,1),sh.Cells(rows.count,1).End( xlup))
rng.EntireRow.copy
dest.PasteSpecial xlValues
dest.PasteSpecial xlFormats

bk.Close SaveChanges:=False
sName = Dir()
Loop
ActiveSheet.Select
ThisWorkbook.Worksheets(1).Name = "Consol_AR_summary"

end sub

--
Regards,
Tom Ogilvy


"Darin Kramer" wrote:


Thanks Gary!!! :) but I need multiple rows - so rows 1 to 300 need to
be selected....

Regards

Darin




*** Sent via Developersdex http://www.developersdex.com ***