Помогите новичку

[Pol]

Как создать макрос, чтобы он сохранял таблицу Exel в двух разных каталогах (не требуя потверждения, если файл с таким именем уже существует) и затем закрывал программу.
Буду благодарен за любую подсказку.

[Хыиуду]

ActiveWorkbook.PublishObjects.Add(xlSourceSheet, "C:\temp\777.xls", "Лист1").Publish
ActiveWorkbook.PublishObjects.Add(xlSourceSheet, "C:\temp1\888.xls", "Лист1").Publish
Application.Quit

Для сохранения можно еще использовать Application.GetSaveAsFilename

[Pol]

Работает. Но сохраняются файлы с расширением .mht.
А если требуется сохранить весь файл Exel (10 рабочих листов) c теми же условиями?

[VictorM]

Код: Выделить всё

Sub Сохранить()
    Dim wb As Workbook, wbName As String
    iSheets = Sheets.Count
    Set wb = Excel.Application.ActiveWorkbook
    For i = 1 To iSheets
        wbName = "Лист_" & i
        wb.SaveCopyAs ("C:\Temp\" + wbName + ".xls")
    Next i
    Application.Quit
End Sub

Подсчитает листы в книге, сохранит каждый поотдельности с именем "Лист_1" и.т.д., по количеству листов и закроет рабочую книгу.

[Teslenko_EA]

Здравствуйте Pol.
если речь о текущей рабочей книге, подобный код будет без проблем и "вопросов" выполнять Вашу задачу

Код: Выделить всё

Sub savSheet()
Const sDir1 = "C:\Temp\", sDir2 = "C:\Temp\TWO\", sSheet = "Лист1"
    If toWB(sDir1 + sSheet + ".xls", sSheet) And toWB(sDir2 + sSheet + ".xls", sSheet) Then
        'файлы скопированы
    Else
        'ошибки при создании файлов
    End If
End Sub
Function toWB(sPath$, sName) As Boolean
On Error Resume Next
    If Len(Dir(sPath)) > 0 Then Kill sPath
    If Err.Number = 0 Then
        Sheets(sName).Copy
        ActiveWorkbook.SaveAs sPath, FileFormat:=xlNormal
        ActiveWindow.Close False
    End If
If Err.Number = 0 Then toWB = True Else Err.Clear
End Function

Евгений.

[Pol]

Код: Выделить всё

Sub Сохранить()
    Dim wb As Workbook, wbName As String
    iSheets = Sheets.Count
    Set wb = Excel.Application.ActiveWorkbook
    For i = 1 To iSheets
        wbName = "Лист_" & i
        wb.SaveCopyAs ("C:\Temp\" + wbName + ".xls")
    Next i
    Application.Quit
End Sub

Подсчитает листы в книге, сохранит каждый поотдельности с именем "Лист_1" и.т.д., по количеству листов и закроет рабочую книгу.

Действительно, сохраняет файлы "Лист_1", "Лист_2" и т.д., но все файлы одинаковые и каждый содержит все рабочие листы. Достаточно сохранить один из файлов. Возможно ли упростить?

[VictorM]

Как создать макрос, чтобы он сохранял таблицу Exel в двух разных каталогах

Каков вопрос - таков ответ...
Видимо я не так Вас понял, что Вы подразумеваете под словом "таблица".
Действительно, вышеопубликованный макрос сохраняет все листы рабочей книги в отдельный файл. Если же Вам нужно сохранить рабочую книгу в двух разных каталогах, то процедура будет выглядеть таким образом:

Код: Выделить всё

Private Sub My_MkDir(iPath$)
    iStart& = 1
    iPathSeparator$ = Application.PathSeparator
    iPath$ = iPath$ & _
             IIf(Right(iPath$, 1) = iPathSeparator$, "", iPathSeparator$)
    Do
        iStart& = InStr(iStart& + 1, iPath$, iPathSeparator$)
        iTempPath$ = Mid(iPath$, 1, iStart&)
        If Dir(iTempPath$, vbDirectory) = "" Then _
           MkDir iTempPath$
    Loop While iStart& <> 0
End Sub
Private Sub Call_My_MkDir()
    My_MkDir "C:\\Temp\Каталог_1\"
    My_MkDir "C:\\Temp\Каталог_2\"
End Sub
Sub СохранитьКнигу2()
    Dim wb As Workbook, wbName As String
    wbName = ActiveWorkbook.Name
    Set wb = Excel.Application.ActiveWorkbook
    Call Call_My_MkDir
    wb.SaveCopyAs ("C:\Temp\Каталог_1\" + wbName)
    wb.SaveCopyAs ("C:\Temp\Каталог_2\" + wbName)
    ActiveWorkbook.Save
    Application.Quit
End Sub

Запустите СохранитьКнигу2.
***
Процедуры My_MkDir(iPath$) и Call_My_MkDir взяты ОТСЮДА, посмотрите, там вообще много интересного и поучительного.

[Teslenko_EA]

Здравствуйте VictorM.
мне кажется Вы ошиблись "чтобы он сохранял таблицу Exel в двух разных каталогах" похоже в этом контексте, таблицей автор называл Лист документа Excel. А может я ошибаюсь, угадать тяжело.
Евгений.

[VictorM]

Здравствуйте Евгений.
Вы правы

угадать тяжело

В любом случае сейчас у автора топика есть всевозможные варианты сохранения, пусть выбирает)
Виктор.