Subroutine works but can it be improved?
 

I hope that the function of this routine is self expanatory. I am hacking as
best as I can but would like some insight on how this routine could be
improved.

Thanks in advance, Dean.

CopySheetValues(pFromFile As String, pFileStatus As String, pFromSheet As
String, pFromRange As String, pToSheet As String, pTextColumns As Long
'-----------------------------------------------------------------------------------'
' This routine will copy values in a named ranged from a spreadsheet tab
specified '
' in the parameters to a spreadsheet tab after clearing out the existing
data and '
' formatting the first n columns as text in ensure proper database
functions.
'-----------------------------------------------------------------------------------'
Dim i As Long
Dim basebook As Workbook
Dim basesheet As Worksheet
Dim baserangeold As Range
Dim baserangenew As Range
Dim frombook As Workbook
Dim fromsheet As Worksheet
Dim fromrange As Range

Application.DisplayAlerts = False

With Application.FileSearch
.NewSearch
.LookIn = ASFilePath
.SearchSubFolders = False
.Filename = pFromFile
.FileType = msoFileTypeExcelWorkbooks
If .Execute() = 0 Then
Beep
MsgBox "Workbook " & pFromFile & " Not Found. Data Not Copied."
ElseIf .Execute() = 1 Then
If WorkbookOpen(pFromFile) Then
Set frombook = Workbooks(pFromFile)
Else
Set frombook = Workbooks.Open(.FoundFiles(1))
End If
Set basebook = ThisWorkbook
Set basesheet = basebook.Worksheets(pToSheet)
Set fromrange =
frombook.Worksheets(pFromSheet).Range(pFromRange)
Set baserangeold = basebook.Worksheets(pToSheet).UsedRange

With fromrange
Set baserangenew =
basebook.Worksheets(pToSheet).Cells(1, 1).Resize(.Rows.Count, .Columns.Count)
End With

baserangeold.ClearContents
basesheet.Activate

If pTextColumns < 0 Then
For i = 1 To pTextColumns
Columns(i).NumberFormat = "@"
Next i
End If

baserangenew.Value = fromrange.Value

If pFileStatus = "Close" Then
frombook.Close
End If
Else
Beep
MsgBox "Multiple Workbooks Found. Data Not Copied."
End If
End With

Set basebook = Nothing
Set basesheet = Nothing
Set baserangeold = Nothing
Set baserangenew = Nothing
Set frombook = Nothing
Set fromsheet = Nothing
Set fromrange = Nothing

Application.DisplayAlerts = True

End Sub