Wants to copy data from one excell to anthor

Hello,


i want to copy the data from one excel to anthor excel. i have the program but i am facing some error in that. kindly help me on this.

Sub CopyDataOfWorkbooks()

Dim objWorkbook As Workbook, objMainWorkbook As Workbook
Dim ArrayWorkbooks() As String
Dim i As Byte

' Setings
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
ReDim ArrayWorkbooks(1 To 2)
ArrayWorkbooks(1) = "c:\Documents and Settings\Name1.xls"
ArrayWorkbooks(2) = "c:\Documents and Settings\Name2.xls"
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Set objMainWorkbook = ActiveWorkbook

For i = 1 To UBound(ArrayWorkbooks)
If Open_Workbook(ArrayWorkbooks(i), objWorkbook) Then
Call CopyEachSheet(objWorkbook, objMainWorkbook)
End If
Next i

Set objMainWorkbook = Nothing: Set objWorkbook = Nothing

MsgBox "Finished"
End Sub

Function Open_Workbook(strFileName As String, objWorkbook As Workbook) As Boolean

If IsMissing(strFileName) = True Or Len(strFileName) < 6 Then
Exit Function
End If

On Error Resume Next
Set objWorkbook = Workbooks.Open(Filename:=strFileName)
If Err.Number <> 0 Then
Open_Workbook = False
Else
Open_Workbook = True
End If
On Error GoTo 0

End Function
Sub CopyEachSheet(objWorkbook As Workbook, objMainWorkbook As Workbook)

Dim TempSheet As Worksheet
Dim strFreeAddress As String

For Each TempSheet In objWorkbook.Worksheets
TempSheet.UsedRange.Copy
strFreeAddress = FindFreeCells(objMainWorkbook, TempSheet.Name)
Sheets(TempSheet.Name).Range(strFreeAddress).PasteSpecial Paste:=xlPasteAll
Next TempSheet

Application.CutCopyMode = False
Application.DisplayAlerts = False
objWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True

Set TempSheet = Nothing: Set objMainWorkbook = Nothing: Set objWorkbook = Nothing
End Sub
Function FindFreeCells(objMainWorkbook As Workbook, strSheetName As String) As String

objMainWorkbook.Activate
' If objMainWorkbook doesn't contain sheet same name, create it
On Error Resume Next
With Sheets(strSheetName)
If Err.Number <> 0 Then
objMainWorkbook.Worksheets.Add(before:=Worksheets(1)).Name = strSheetName
FindFreeCells = "A1"
On Error GoTo 0
Else
FindFreeCells = .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, 1).Address
End If
End With

Set objMainWorkbook = Nothing

End Function