Ron, sorry I mixed up my postings.

I used your macro (as shown in code below).

So again, removing the header record from each file before bringing it in?

Thanks

Private Declare Function SetCurrentDirectoryA Lib _
   "kernel32" (ByVal lpPathName As String) As Long

Public Sub ChDirNet(szPath As String)
' Rob Bovey
   Dim lReturn As Long
   lReturn = SetCurrentDirectoryA(szPath)
   If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub

Sub Merge_Selected()
   Dim MyPath As String
   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 SaveDriveDir As String
   Dim FName As Variant

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

   SaveDriveDir = CurDir
   ChDirNet "C:\Documents and Settings\zandveldd\My Documents\Info Record
Change Tool\Vendor Files"

   FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*),
*.xl*", _
                                       MultiSelect:=True)
   If IsArray(FName) Then

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

       'Loop through all files in the array(myFiles)
       For Fnum = LBound(FName) To UBound(FName)
           Set mybook = Nothing
           On Error Resume Next
           Set mybook = Workbooks.Open(FName(Fnum))
           On Error GoTo 0

           If Not mybook Is Nothing Then

               On Error Resume Next
               With mybook.Worksheets(1)
                   Set sourceRange = .Range("A1:C1")
               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 = FName(Fnum)
                       End With

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

                       'we copy the values from the sourceRange to the
destrange
                       With sourceRange
                           Set destrange = BaseWks.Cells(rnum, "B"). _
                                           Resize(.Rows.Count,
.Columns.Count)
                       End With
                       destrange.Value = sourceRange.Value

                       rnum = rnum + SourceRcount
                   End If
               End If
               mybook.Close savechanges:=False
           End If

       Next Fnum
       BaseWks.Columns.AutoFit
   End If

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