Здравствуйте!  
 
Подскажите пожалуйста, как можно подправить данный код (взят с http://forum.ixbt.com/topic.cgi?id=23:34091) следующим образом:  
 
- имена нужных файлов указаны/прописаны заранее (их штук 10)  
- во всех книгах берутся данные только с одного листа (во всех книгах называется одинаково)  
- строки собираются на конкретный лист конкретной книги (в которой макрос и расположен)  
 
Вот сам макрос:  
 
{quote}Sub Объединение_файлов()  
   
Const strStartDir = "c:\test" 'папка, с которой начать обзор файлов  
Const strSaveDir = "c:\test\result" 'папка, в которую будет предложено сохранить результат  
   
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _  
   i As Integer, stbar As Boolean  
   
On Error Resume Next    'если указанный путь не существует, обзор начнется с пути по умолчанию  
ChDir strStartDir  
On Error GoTo 0  
With Application    'меньше писанины  
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)  
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла  
Set wbTarget = Workbooks.Add(template:=xlWorksheet)  
   .ScreenUpdating = False  
   stbar = .DisplayStatusBar  
   .DisplayStatusBar = True  
   
For i = 1 To UBound(arFiles)  
   .StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)  
   Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)  
   For Each shSrc In wbSrc.Worksheets  
       If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой  
           Set shTarget = wbTarget.Sheets.Add(after:=wbTarget.Sheets(wbTarget.Sheets.Count))  
           shTarget.Name = Left(Replace(wbSrc.Name, ".xls", "") & "." & shSrc.Name, 31)  
           shSrc.Cells.Copy shTarget.Range("A1")  
       End If  
   Next  
   wbSrc.Close False   'закрыть без запроса на сохранение  
Next  
   .ScreenUpdating = True  
   .DisplayStatusBar = stbar  
   .StatusBar = False  
   
If wbTarget.Sheets.Count = 1 Then 'не добавлено ни одного листа  
   MsgBox "В указанных книгах нет непустых листов, сохранять нечего!"  
   wbTarget.Close False  
   End  
Else  
   .DisplayAlerts = False  
   wbTarget.Sheets(1).Delete  
   .DisplayAlerts = True  
End If  
   
On Error Resume Next    'если указанный путь не существует и его не удается создать,  
                       'обзор начнется с последней использованной папки  
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir  
ChDir strSaveDir  
On Error GoTo 0  
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")  
   
If VarType(arFiles) = vbBoolean Then 'если не выбрано имя  
   GoTo save_err  
Else  
   On Error GoTo save_err  
   wbTarget.SaveAs arFiles  
End If  
End  
save_err:  
   MsgBox "Книга не сохранена!", vbCritical  
End With  
End Sub{/quote}