Sub tt()
Sub tt()
    Dim fd As FileDialog
    On Error Resume Next
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*"
        .ButtonName = "Выбрать"
        .AllowMultiSelect = 1
        .Title = "                   !!!!!!!Выберите с нажатым Контрл или Шифт"
        .InitialView = msoFileDialogViewDetails
        .Show
        sn_ = "nnn" 'имя переносимого листа
        Application.ScreenUpdating = 0
        Application.DisplayAlerts = 0
        For i = 1 To .SelectedItems.Count
            fl_ = 1
            p_ = .SelectedItems(i)
            fn_ = Mid(p_, InStrRev(p_, "\") + 1)
            Workbooks.Open Filename:=p_
            With Workbooks(fn_)
                Err.Clear
                si_ = .Sheets(sn_).Index
                If Err = 0 Then
                    If MsgBox("В книге ''" & .Name & "'' уже есть лист ''" & sn_ & "''." & vbLf & "Заменить?", vbYesNo) = 6 Then
                        .Sheets(sn_).Delete
                    Else
                        fl_ = 0
                    End If
                End If
                If fl_ Then
                    ThisWorkbook.Sheets(sn_).Copy After:=.Sheets(.Sheets.Count)
                    .ChangeLink Name:=ThisWorkbook.Name, NewName:=.Name, Type:=xlExcelLinks
                End If
                .Close fl_
            End With
        Next i
        Application.DisplayAlerts = 1
        Application.ScreenUpdating = 1
    End With
End Sub