Hi Ron,

Thanks for all your help so far.....need you further help on this.

For finding the last row in the worksheet to be copied from-
a) Suppose I want to find "Total" and that would be last row in the
source range. Do I need to change the "*" to "Total".
b) Second option available to me is that i would find the last row on
the basis of the end of the column. For eg. I have column A with data
from A1 to A50, then some blank rows and thereafter some more data.
Here, i would like to find out data using function something like this
"Range("A1").End(xldown).Select". I would not like to use xlup in this
case.

Hope you understand what I am trying to explain.

Can you please help me out.

Regards,
Gaurav

On Dec 6, 8:32*pm, "Ron de Bruin" wrote:
Hi

This example will copy alldatafrom the first worksheet in each workbook to a new workbook

Copy the macro and function in the workbook with the file names in column A in a sheet named "sheet1"
Or change the sheet name here :

*For Each cell In ThisWorkbook.Sheets("Sheet1"). _
* * * * Range("A1:A100").SpecialCells(xlCellTypeConstants)

If you not want to copy the header row each time change A1 to A2 in this line
*FirstCell = "A1"

Sub Basic_Example_Test()
* * Dim SourceRcount As Long, Fnum As Long
* * Dim mybook As Workbook, BaseWks As Worksheet
* * Dim sourceRange As Range, destrange As Range
* * Dim rnum As Long, CalcMode As Long
* * Dim cell As Range
* * Dim FirstCell As String

* * 'Change ScreenUpdating, Calculation and EnableEvents
* * With Application
* * * * CalcMode = .Calculation
* * * * .Calculation = xlCalculationManual
* * * * .ScreenUpdating = False
* * * * .EnableEvents = False
* * End With

* * 'Add a new workbook with one sheet
* * Set BaseWks =Workbooks.Add(xlWBATWorksheet).Worksheets(1)
* * rnum = 1

* * 'Loop through all files on Sheet1 in A1:A100
* * For Each cell In ThisWorkbook.Sheets("Sheet1"). _
* * * * Range("A1:A100").SpecialCells(xlCellTypeConstants)

* * * * If Dir(cell.Value) < "" Then
* * * * * * Set mybook = Nothing
* * * * * * On Error Resume Next
* * * * * * Set mybook =Workbooks.Open(cell.Value)

* * * * * * On Error GoTo 0

* * * * * * If Not mybook Is Nothing Then

* * * * * * * * On Error Resume Next

* * * * * * * * With mybook.Worksheets(1)
* * * * * * * * * * FirstCell = "A1"
* * * * * * * * * * Set sourceRange = .Range(FirstCell & ":" & RDB_Last(3, .Cells))
* * * * * * * * * * 'Test if the row of the last cell = then the row of the FirstCell
* * * * * * * * * * If RDB_Last(1, .Cells) < .Range(FirstCell).Row Then
* * * * * * * * * * * * Set sourceRange = Nothing
* * * * * * * * * * End If
* * * * * * * * End With

* * * * * * * * If Err.Number 0 Then
* * * * * * * * * * Err.Clear
* * * * * * * * * * Set sourceRange = Nothing
* * * * * * * * Else
* * * * * * * * * * 'if SourceRange use all columns then skip this file
* * * * * * * * * * If sourceRange.Columns.Count = BaseWks.Columns.Count Then
* * * * * * * * * * * * Set sourceRange = Nothing
* * * * * * * * * * End If
* * * * * * * * End If
* * * * * * * * On Error GoTo 0

* * * * * * * * If Not sourceRange Is Nothing Then

* * * * * * * * * * SourceRcount = sourceRange.Rows..Count

* * * * * * * * * * If rnum + SourceRcount = BaseWks.Rows.Count Then
* * * * * * * * * * * * MsgBox "Sorry there are not enough rows in the sheet"
* * * * * * * * * * * * BaseWks.Columns.AutoFit
* * * * * * * * * * * * mybook.Close savechanges:=False
* * * * * * * * * * * * GoTo ExitTheSub
* * * * * * * * * * Else

* * * * * * * * * * * * 'Copy the file name in column A
* * * * * * * * * * * * With sourceRange
* * * * * * * * * * * * * * BaseWks.Cells(rnum, "A"). _
* * * * * * * * * * * * * * * * * * Resize(.Rows.Count).Value = cell.Value
* * * * * * * * * * * * End With

* * * * * * * * * * * * 'Set the destrange
* * * * * * * * * * * * Set destrange = BaseWks..Range("B" & rnum)

* * * * * * * * * * * * 'we copy the values from the sourceRange to the destrange
* * * * * * * * * * * * sourceRange.Copy
* * * * * * * * * * * * With destrange
* * * * * * * * * * * * * * .PasteSpecial xlPasteValues
* * * * * * * * * * * * * * .PasteSpecial xlPasteFormats
* * * * * * * * * * * * * * Application.CutCopyMode = False
* * * * * * * * * * * * End With
* * * * * * * * * * * * rnum = rnum + SourceRcount
* * * * * * * * * * End If
* * * * * * * * End If
* * * * * * * * mybook.Close savechanges:=False
* * * * * * End If
* * * * End If
* * Next cell
* * BaseWks.Columns.AutoFit
* * Application.Goto BaseWks.Cells(1)

ExitTheSub:
* * 'Restore ScreenUpdating, Calculation and EnableEvents
* * With Application
* * * * .ScreenUpdating = True
* * * * .EnableEvents = True
* * * * .Calculation = CalcMode
* * End With
End Sub

Function RDB_Last(choice As Integer, rng As Range)
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
' 3 = last cell
* * Dim lrw As Long
* * Dim lcol As Integer

* * Select Case choice

* * Case 1:
* * * * On Error Resume Next
* * * * RDB_Last = rng.Find(What:="*", _
* * * * * * * * * * * * * * after:=rng.Cells(1), _
* * * * * * * * * * * * * * Lookat:=xlPart, _
* * * * * * * * * * * * * * LookIn:=xlFormulas, _
* * * * * * * * * * * * * * SearchOrder:=xlByRows, _
* * * * * * * * * * * * * * SearchDirection:=xlPrevious, _
* * * * * * * * * * * * * * MatchCase:=False).Row
* * * * On Error GoTo 0

* * Case 2:
* * * * On Error Resume Next
* * * * RDB_Last = rng.Find(What:="*", _
* * * * * * * * * * * * * * after:=rng.Cells(1), _
* * * * * * * * * * * * * * Lookat:=xlPart, _
* * * * * * * * * * * * * * LookIn:=xlFormulas, _
* * * * * * * * * * * * * * SearchOrder:=xlByColumns, _
* * * * * * * * * * * * * * SearchDirection:=xlPrevious, _
* * * * * * * * * * * * * * MatchCase:=False).Column
* * * * On Error GoTo 0

* * Case 3:
* * * * On Error Resume Next
* * * * lrw = rng.Find(What:="*", _
* * * * * * * * * * * *after:=rng.Cells(1), _
* * * * * * * * * * * *Lookat:=xlPart, _
* * * * * * * * * * * *LookIn:=xlFormulas, _
* * * * * * * * * * * *SearchOrder:=xlByRows, _
* * * * * * * * * * * *SearchDirection:=xlPrevious, _
* * * * * * * * * * * *MatchCase:=False).Row
* * * * On Error GoTo 0

* * * * On Error Resume Next
* * * * lcol = rng.Find(What:="*", _
* * * * * * * * * * * * after:=rng.Cells(1), _
* * * * * * * * * * * * Lookat:=xlPart, _
* * * * * * * * * * * * LookIn:=xlFormulas, _
* * * * * * * * * * * * SearchOrder:=xlByColumns, _
* * * * * * * * * * * * SearchDirection:=xlPrevious, _
* * * * * * * * * * * * MatchCase:=False).Column
* * * * On Error GoTo 0

* * * * On Error Resume Next
* * * * RDB_Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
* * * * If Err.Number 0 Then
* * * * * * RDB_Last = rng.Cells(1).Address(False, False)
* * * * * * Err.Clear
* * * * End If
* * * * On Error GoTo 0

* * End Select
End Function

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

wrote in ...
A list of excel files with complete path is entered into column A of
the workbook. Is it possible to open those files and paste the visible
rows into new excel workbook. There are more than 50 files to be
opened and pasted. One thing need to be sure while pasting, that when
second file is opened and pasted, numbers are pasted at the last row
of new excel workbook created.

Thanks in advance.