John,

The following finds and opens two files.
It will grab the first file that has any 4 numbers followed
by "-Item.xls" or "-Wire.xls"
The "like" operator is used to identify the files,
and as written should find the two files you need.
You must specify the folder the files are in (strPath).
If you don't know the folder path then it is still
possible to find the files, but the code would have to be
rewritten to also search thru sub-folders.

Regards,
Jim Cone
San Francisco, USA

'--------------------------------------
Sub OpenTwoFiles()
'Jim Cone - San Francisco, USA - Sept. 05, 2005
'******
'Requires a project reference to the "Microsoft Scripting Runtime" library
'******
'Finds the first two files that meet the specified criteria.
'Files must exist in the specified strPath folder.

Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim strPath As String
Dim strItemFile As String
Dim strWireFile As String

' Specify the folder...
strPath = "C:\Documents and Settings\user\My Documents\Excel Files"
Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder(strPath)

'Find Item file...
For Each objFile In objFolder.Files
If objFile.Name Like "####-Item.xls" Then
strItemFile = objFile.Path
Exit For
End If
Next 'objFile

'Find Wire file...
For Each objFile In objFolder.Files
If objFile.Name Like "####-Wire.xls" Then
strWireFile = objFile.Path
Exit For
End If
Next 'objFile

'Open the files...
If Len(strItemFile) Then
Workbooks.Open strItemFile
Else
MsgBox "Can't find Item file. "
End If
If Len(strWireFile) Then
Workbooks.Open strWireFile
Else
MsgBox "Can't find Wire file. "
End If
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
End Sub
'----------------------------------


"John"
wrote in message

Hello All, I want to be able to import data from two separate wookbooks with
very similar names into a third wookbook (named QIC_AM) which has all the
macros with a single click of the macro button. With the programming I have
now, the open dialogue box opens and I have to select the first individual
file and it copies all the data from the only sheet in the workbook and
pastes into QIC_AM onto sheet 1 named "items". Then the open dialogue box
opens again and I have to select the second workbook. This is copied into a
second worksheet in QIC_AM named "wires". Both 1st and 2nd workbooks will
then close. From there QIC_AM calculates various data.

Two individual workbooks will always be named similar. Examples are
1234-item.xls and 1234-wires.xls where the "-items.xls" and "-wires.xls" will
be constant.
How can I have Excel look for the "-wires.xls" that matches the first file
selected automatically? Below is the programming I have that I use today.

Dim Cell As Range
On Error GoTo errorhandler
Workbooks.Open Filename:=Dir(Application.GetOpenFilename), UpdateLinks:=0
Range("A1").Select
cellcheck = ActiveCell(1, 1)
If cellcheck < "POS NBR" Then
Application.ScreenUpdating = True
MsgBox ("This File " & filetoopenitems & " Does Not Seem to be an
Item Chart, please check the file name and start again")
ActiveWorkbook.Close
ThisWorkbook.Activate
End
End If
Cells.Select
Selection.Copy
Windows("QIC_AM_r06 for GSD.xls").Activate
Sheets("Item Charts").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.autofit
Range("A1").Select
Workbooks.Open Filename:=Dir(Application.GetOpenFilename), UpdateLinks:=0
Range("A1").Select
cellcheck = ActiveCell(1, 1)
If cellcheck < "CIRCUIT NBR" Then
Application.ScreenUpdating = True
MsgBox ("This File " & filetoopenitems & " Does Not Seem to be a
Wire Chart, please check the file name and start again")
Dim WkbkName As Object
For Each WkbkName In Application.Workbooks()
If WkbkName.Name < ThisWorkbook.Name Then WkbkName.Close
Next
ThisWorkbook.Activate
Selection.ClearContents
Range("A1").Select
End
End If
Cells.Select
Selection.Copy
Windows("QIC_AM_r06 for GSD.xls").Activate
Sheets("Wire Charts").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.autofit
Range("A1").Select
For Each WkbkName In Application.Workbooks()
If WkbkName.Name < ThisWorkbook.Name Then WkbkName.Close
Next
If Workbooks("QIC_AM_r06 for GSD.xls").Sheets("Wire Charts").Range("A2")
< Workbooks("QIC_AM_r06 for GSD.xls").Sheets("Item Charts").Range("A2") Then
Application.ScreenUpdating = True
MsgBox ("These Files Do Not Seem to be the same harness assembly,
please check the file name and start again")
End
End If

Would appreciate any help anyone can give me.--
John S. Walker