Необходимо скопировать 1 лист из одной книги в большое количество других книг

[Nick-1984]

Задача такая. Есть одна книга которая содержит лист, который нужно скопировать во все книги в определенной папке (сохраняя формулы). Помогите дописать середину кода:
Private Sub CommandButton1_Click()

start: DestinationFolder = GetFolderPath("Выберите папку для просмотра списка файлов", "H:\Расчет резерва\")
' можешь заменить C:\Windows\ на любой другой путь, с которого должен начинаться выбор папки

If DestinationFolder = "" Then
Select Case MsgBox("Папка для просмотра не выбрана. Повторить?", vbQuestion + vbOKCancel, "Папка не выбрана")
Case vbOK: GoTo start
Case vbCancel: Exit Sub
End Select
Else
CreateDirectoryListing DestinationFolder
End If
End Sub

Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", Optional ByVal InitialPath As String = "c:\") As String
GetFolderPath = "": PS = Application.PathSeparator
With Application.FileDialog(msoFileDialo gFolderPicker)
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
If .Show = -1 Then GetFolderPath = .SelectedItems(1): If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
End With
End Function

Sub CreateDirectoryListing(Optional ByVal FolderPath As String = "='H:\Расчет резерва\4 квартал 2010\")
On Error Resume Next
'Dim fso As FileSystemObject, f As Folder, fl As File, fld As Folder

Set fso = CreateObject("Scripting.FileSystemO bject")
Set f = fso.GetFolder(FolderPath)

Application.ScreenUpdating = False
Set sh = ActiveSheet
ro = 2
With sh

ro = ro + 2

For Each fl In f.Files

как прописать здесь код копирования листа???

Next


.Columns("a:e").AutoFit


End With
Application.ScreenUpdating = True
End Sub

[Казанский]

'как прописать здесь код копирования листа???
With Workbooks.Open(fl.Path)
    sh.Copy before:=.Sheets(1) 'вставить перед первым листом книги
    .Close True
End With

[Nick-1984]

Но одна проблема. У меня на листе который я копирую есть формулы. И лист который копируется получается с ссылками на исходный файл (с кототрого копирую лист), а надо чтобы ссылался на ячейки в книге в которую скопировался лист. Короче, надо чтобы связей со старой книгой не было.

[Казанский]

Попробуйте - без проверки на наличие формул и на наличие нужных листов в книгах:

Dim rFormulas As Range, a As Range
Set rFormulas = sh.Cells.SpecialCells(xlCellTypeFormulas)
With Workbooks.Open(fl.Path)
    sh.Copy before:=.Sheets(1)
    For Each a In rFormulas.Areas
        ActiveSheet.Range(a.Address).Formula = a.Formula
    Next
    .Close True
End With

[Nick-1984]

Все работает. Спасибо!!!