Help adding info from Multiple Books to 1 sheet.
 

I'm trying to add code to the following that will allow me to open
another file and copy the same information from cell D1 into my
orderform.xls starting at A2 then A3 and so on for as many files that
are renamed.

He is a copy of the code I currently have.

Thanks for the Help.



Sub CompileCabinets()

Dim Example()
Dim mybook As Workbook
Dim N As Long
Dim MyPath As String
Dim SaveDriveDir As String
Dim FName As Variant


SaveDriveDir = CurDir
MyPath = "C:\Sample\"
ChDrive MyPath
ChDir MyPath


FName = Application.GetOpenFilename(filefilter:="Excel Files
(*.xls), *.xls", _
MultiSelect:=True)

If IsArray(FName) Then
Application.ScreenUpdating = False


For N = LBound(FName) To UBound(FName)
Set mybook = Workbooks.Open(FName(N))

Range("E28").Select
Selection.TextToColumns Destination:=Range("E28"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote,
ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False,
Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 9)),
TrailingMinusNumbers:=True
Range("E28").Select
Selection.Copy

Range("R40").Select
ActiveSheet.Paste

Columns("D:N").Select
Range("D24").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("E:F").Select
Range("E24").Activate
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Range("A24").Activate
Selection.Delete Shift:=xlToLeft

Rows("1:39").Select
Selection.Delete Shift:=xlUp

Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Cells.Select
Selection.Sort Key1:=Range("A1"),
Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("2:3").Select
Selection.Delete Shift:=xlUp

mybook.SaveAs Sheets(1).Range("D1") & ".xls"
mybook.Close False
Next
End If
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True

End Sub