Vba Code To Copy Data From One Workbook To Another Workbook

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