Ron:

I used your code and change neccessary parameter as mentioned in your
website, there is no more error message, but there is nothing in the sheet 1.

What did I miss here. Do you think it is because I assinged
"MergeSpecificWorkbooks" to a shape ( a kind of a button) in order to run the
macro?.

Or what is the ther "Kernell32", is it something that we must change?.

This is the whole VBA after my modification from yours:

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

Sub ChDirNet(szPath As String)
SetCurrentDirectoryA szPath
End Sub
Sub MergeSpecificWorkbooks()
Dim MyPath As String
Dim MyFiles() 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


' Set application properties.
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

SaveDriveDir = CurDir
' Change this to the path\folder location of the files.
ChDirNet "\\Admin-hdd\budget-contr\BUDGET CONTROL M\BUDGET 2009"

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 myFiles array.
For FNum = LBound(FName) To UBound(FName)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(FNum), _
Password:="TIPTOP", WriteResPassword:="TIPTOP", UpdateLinks:=0)

On Error GoTo 0

If Not mybook Is Nothing Then

On Error Resume Next
With mybook.Worksheets("SUMMARY")
Set sourceRange =
..Range("C7,C8,E7,D118,H5,D63,E63,D70,F70," & _
"D80,F80,D102,F102,D108,D109")
End With

If Err.Number 0 Then
Err.Clear
Set sourceRange = Nothing
Else
' If the source range uses 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 "There are not enough rows in the target
worksheet."
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 destination range.
Set destrange = BaseWks.Range("B" & rnum)

' Copy the values from the source range
' to the destination range.
With sourceRange
Set destrange = destrange. _
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 the application properties.
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
ChDirNet SaveDriveDir
End Sub

I appreciate your help Ron

Frank



"Ron de Bruin" wrote:

Hi Frank

You posted a few times this week but I hade no time to answer

Ado will not work with password protected workbooks
If it is one password for all workbooks use my Add-in to get the info
http://www.rondebruin.nl/merge.htm

Or use the code here
http://www.rondebruin.nl/copy3.htm
Read the tips part




--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"Frank Situmorang" wrote in message
...
Hello,

In a server, I have about 300 workbooks in a server. All the workbooks are
indentical and have sheet named " SUMMARY". Without bothering people who
maybe using it, how can I get the information of each worksheet from the cell
range:
Range("C7,C8,E7,D118,H5,D63,E63,D70,F70," & _
"D80,F80,D102,F102,D108,D109")

and summaryize it in a workbook without opening each workbook. Should we use
ADO or DAO to do it?, Please help.

For your information if we open the workbook manuallly it prompts us to kein
the password, which is a window password, say "TopSecret", all the same
password for each workbook.

Thanks in advance,

Frank