Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Экспорт страниц в отдельные файлы и создание этих файлов - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Экспорт страниц в отдельные файлы и создание этих файлов (Макросы/Sub)
Экспорт страниц в отдельные файлы и создание этих файлов
koyaanisqatsi Дата: Суббота, 29.12.2018, 10:50 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
Доброго времени уток.
Хочу Попросить о помощи. Если вас конечно не затруднит по доброте душевной.
У меня есть код ВБА. Он выгружает странички в отдельные файлы. Я хотел было сам попробовать разобраться. Но ВБА еще хуже понимаю чем формулы.
А для вас скорее всего это пару пустяков.
Сейчас файл создает два файла один для бухгалтерии где итоги по суммам "бухПриход" и файл "Экспорт"

вот теперь потребовалось изменить часть которая относится к файлу с экспортом и вместо этого файла теперь надо создавать 4 разных файла из одноименных страниц.
Список страничек одноименных
ЭкспортБМ
ЭкспортЛимак
ЭкспортАртис
ЭкспортБЗУ

[vba]
Код

Sub Лист_экспорт()
    Dim cPath As String, cPrefix As String, cName As String
    cPath = ThisWorkbook.Path & "\экспорт\"
    cPrefix = "Экспорт "
    cName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    
    Dim wbC As Workbook, wbE As Workbook
    Application.ScreenUpdating = False
    Set wbC = ThisWorkbook
    Set wbE = Workbooks.Add
    wbE.Sheets(1).Name = "Экспорт"
    wbC.Sheets("Экспорт").Cells.Copy
    wbE.Sheets("Экспорт").[a1].PasteSpecial xlPasteValues
    Application.DisplayAlerts = False
    wbE.SaveAs cName
    wbE.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    
    Dim bPath As String, bPrefix As String, bName As String
    bPath = "D:\ОБЩИЕ_ДОКУМЕНТЫ\Бухгалтерия\Овощи_приход\"
    bPrefix = "БухПриход "
    bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    Debug.Print bName
    Dim wbQ As Workbook, wbA As Workbook
    Application.ScreenUpdating = False
    Set wbQ = ThisWorkbook
    Set wbA = Workbooks.Add
    wbA.Sheets(3).Name = "Экспорт"
    wbQ.Sheets("Экспорт").Cells.Copy
    wbA.Sheets("Экспорт").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.Sheets(1).Name = "БухПрих"
    wbQ.Sheets("БухПрих").Cells.Copy
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteFormats
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    'wbA.Sheets(2).Name = "Выб. БУХ"
    'wbQ.Sheets("Выб. БУХ").Cells.Copy
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteFormats
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.SaveAs bName
    wbA.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub
[/vba]

Спасибо.
 
Ответить
СообщениеДоброго времени уток.
Хочу Попросить о помощи. Если вас конечно не затруднит по доброте душевной.
У меня есть код ВБА. Он выгружает странички в отдельные файлы. Я хотел было сам попробовать разобраться. Но ВБА еще хуже понимаю чем формулы.
А для вас скорее всего это пару пустяков.
Сейчас файл создает два файла один для бухгалтерии где итоги по суммам "бухПриход" и файл "Экспорт"

вот теперь потребовалось изменить часть которая относится к файлу с экспортом и вместо этого файла теперь надо создавать 4 разных файла из одноименных страниц.
Список страничек одноименных
ЭкспортБМ
ЭкспортЛимак
ЭкспортАртис
ЭкспортБЗУ

[vba]
Код

Sub Лист_экспорт()
    Dim cPath As String, cPrefix As String, cName As String
    cPath = ThisWorkbook.Path & "\экспорт\"
    cPrefix = "Экспорт "
    cName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    
    Dim wbC As Workbook, wbE As Workbook
    Application.ScreenUpdating = False
    Set wbC = ThisWorkbook
    Set wbE = Workbooks.Add
    wbE.Sheets(1).Name = "Экспорт"
    wbC.Sheets("Экспорт").Cells.Copy
    wbE.Sheets("Экспорт").[a1].PasteSpecial xlPasteValues
    Application.DisplayAlerts = False
    wbE.SaveAs cName
    wbE.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    
    Dim bPath As String, bPrefix As String, bName As String
    bPath = "D:\ОБЩИЕ_ДОКУМЕНТЫ\Бухгалтерия\Овощи_приход\"
    bPrefix = "БухПриход "
    bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    Debug.Print bName
    Dim wbQ As Workbook, wbA As Workbook
    Application.ScreenUpdating = False
    Set wbQ = ThisWorkbook
    Set wbA = Workbooks.Add
    wbA.Sheets(3).Name = "Экспорт"
    wbQ.Sheets("Экспорт").Cells.Copy
    wbA.Sheets("Экспорт").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.Sheets(1).Name = "БухПрих"
    wbQ.Sheets("БухПрих").Cells.Copy
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteFormats
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    'wbA.Sheets(2).Name = "Выб. БУХ"
    'wbQ.Sheets("Выб. БУХ").Cells.Copy
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteFormats
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.SaveAs bName
    wbA.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub
[/vba]

Спасибо.

Автор - koyaanisqatsi
Дата добавления - 29.12.2018 в 10:50
Roman777 Дата: Воскресенье, 30.12.2018, 19:00 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
koyaanisqatsi,
Вот этот кусок можно попробовать заменить:
[vba]
Код
    Set wbE = Workbooks.Add
    wbE.Sheets(1).Name = "Экспорт"
    wbC.Sheets("Экспорт").Cells.Copy
    wbE.Sheets("Экспорт").[a1].PasteSpecial xlPasteValues
    Application.DisplayAlerts = False
    wbE.SaveAs cName
    wbE.Close False
[/vba]
на:
[vba]
Код
Dim a(1 to 4) as string
a(1) = "ЭкспортБМ"
a(2) = "ЭкспортЛимак"
a(3) = "ЭкспортАртис"
a(4) = "ЭкспортБЗУ"

For i =1 to Ubound(a)
    Set wbE = Workbooks.Add
    with wbE.sheets(1)
        .Name = a(i)
        wbC.Sheets(a(i)).Cells.Copy
        .[a1].PasteSpecial xlPasteValues
    end with
    wbE.SaveAs cName
    wbE.Close False
next i
Application.DisplayAlerts = False
[/vba]
[p.s.]проверить пока не могу[/p.s.]

и скорее всего строки:
[vba]
Код
    wbE.SaveAs cName
    wbE.Close False
[/vba]
можно заменить на одну:
[vba]
Код
wbE.Close true
[/vba]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Воскресенье, 30.12.2018, 19:03
 
Ответить
Сообщениеkoyaanisqatsi,
Вот этот кусок можно попробовать заменить:
[vba]
Код
    Set wbE = Workbooks.Add
    wbE.Sheets(1).Name = "Экспорт"
    wbC.Sheets("Экспорт").Cells.Copy
    wbE.Sheets("Экспорт").[a1].PasteSpecial xlPasteValues
    Application.DisplayAlerts = False
    wbE.SaveAs cName
    wbE.Close False
[/vba]
на:
[vba]
Код
Dim a(1 to 4) as string
a(1) = "ЭкспортБМ"
a(2) = "ЭкспортЛимак"
a(3) = "ЭкспортАртис"
a(4) = "ЭкспортБЗУ"

For i =1 to Ubound(a)
    Set wbE = Workbooks.Add
    with wbE.sheets(1)
        .Name = a(i)
        wbC.Sheets(a(i)).Cells.Copy
        .[a1].PasteSpecial xlPasteValues
    end with
    wbE.SaveAs cName
    wbE.Close False
next i
Application.DisplayAlerts = False
[/vba]
[p.s.]проверить пока не могу[/p.s.]

и скорее всего строки:
[vba]
Код
    wbE.SaveAs cName
    wbE.Close False
[/vba]
можно заменить на одну:
[vba]
Код
wbE.Close true
[/vba]

Автор - Roman777
Дата добавления - 30.12.2018 в 19:00
koyaanisqatsi Дата: Среда, 09.01.2019, 18:29 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
почему-то поругался (
 
Ответить
Сообщениепочему-то поругался (

Автор - koyaanisqatsi
Дата добавления - 09.01.2019 в 18:29
Pelena Дата: Среда, 09.01.2019, 19:25 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Либо добавьте строку [vba]
Код
Dim i as Long
[/vba] либо удалите строку [vba]
Код
Option Explicit
[/vba]


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЛибо добавьте строку [vba]
Код
Dim i as Long
[/vba] либо удалите строку [vba]
Код
Option Explicit
[/vba]

Автор - Pelena
Дата добавления - 09.01.2019 в 19:25
_Boroda_ Дата: Среда, 09.01.2019, 20:56 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16674
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Чуть поясню - оператор Option Explicit заставляет нас объявлять все переменные. https://docs.microsoft.com/ru-ru....atement
Чаще всего это делается с помощью Dim. https://docs.microsoft.com/ru-ru....a-types
В нем можно (нужно) писать тип данных[vba]
Код
Dim i as Byte
[/vba], а можно поразгильдяйничать (как я обычно делаю) и не писать[vba]
Код
Dim i
[/vba]тогда тип данных по умолчанию будет Variant (он занимает больше места и есть еще несколько минусов

Если же совсем облениться (вот это как раз мой случай), то можно стереть обычно появляющуюся автоматически строку Option Explicit и тогда переменные не нужно вообще никак объявлять (и они по умолчанию будут типа Variant). Вернее нужно объявлять все равно, но это становится уже необязательным. А можно вообще один раз снять галку в VBA Tools - Options - Require... и тогда в новых модулях запись Option Explicit автоматически появляться не будет.
Но здесь нужно быть очень внимательным - если в первом случае (с записью Dim i) мы просто занимаем больше места, то во втором мы можем попасть на неверное написание переменных (обычно случайное, типа nm и mn), которое иногда не так-то просто обнаружить в коде.
Ну и вообще это непофеншуйная запись


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЧуть поясню - оператор Option Explicit заставляет нас объявлять все переменные. https://docs.microsoft.com/ru-ru....atement
Чаще всего это делается с помощью Dim. https://docs.microsoft.com/ru-ru....a-types
В нем можно (нужно) писать тип данных[vba]
Код
Dim i as Byte
[/vba], а можно поразгильдяйничать (как я обычно делаю) и не писать[vba]
Код
Dim i
[/vba]тогда тип данных по умолчанию будет Variant (он занимает больше места и есть еще несколько минусов

Если же совсем облениться (вот это как раз мой случай), то можно стереть обычно появляющуюся автоматически строку Option Explicit и тогда переменные не нужно вообще никак объявлять (и они по умолчанию будут типа Variant). Вернее нужно объявлять все равно, но это становится уже необязательным. А можно вообще один раз снять галку в VBA Tools - Options - Require... и тогда в новых модулях запись Option Explicit автоматически появляться не будет.
Но здесь нужно быть очень внимательным - если в первом случае (с записью Dim i) мы просто занимаем больше места, то во втором мы можем попасть на неверное написание переменных (обычно случайное, типа nm и mn), которое иногда не так-то просто обнаружить в коде.
Ну и вообще это непофеншуйная запись

Автор - _Boroda_
Дата добавления - 09.01.2019 в 20:56
vikttur Дата: Среда, 09.01.2019, 21:49 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2941
Репутация: 526 ±
Замечаний: 0% ±

Вот-вот... поэтому плохому учить можно, но не в этом случае :)
Пример: буква с в качестве переменной, записанная случайно кириллицей. Намучитесь, пока поймете, где ошибка. При наличии Option Explicit ошибка выявляется сразу.

Рекомендую ВСЕГДА использовать Option Explicit и объявлять переменные. А перед запуском написанного или измененного кода откомпилировать его (меню Debug-Compile VBAProject)
Option Explicit здорово помогает при написании кода, Compile VBAProject сохранит время и нервы, которые были бы убиты при многократном запуске кода и удалении ошибок компиляции.
 
Ответить
СообщениеВот-вот... поэтому плохому учить можно, но не в этом случае :)
Пример: буква с в качестве переменной, записанная случайно кириллицей. Намучитесь, пока поймете, где ошибка. При наличии Option Explicit ошибка выявляется сразу.

Рекомендую ВСЕГДА использовать Option Explicit и объявлять переменные. А перед запуском написанного или измененного кода откомпилировать его (меню Debug-Compile VBAProject)
Option Explicit здорово помогает при написании кода, Compile VBAProject сохранит время и нервы, которые были бы убиты при многократном запуске кода и удалении ошибок компиляции.

Автор - vikttur
Дата добавления - 09.01.2019 в 21:49
koyaanisqatsi Дата: Четверг, 10.01.2019, 09:54 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
_Boroda_,
при добавлении [vba]
Код
Dim i as Byte
[/vba] или удалении [vba]
Код
Option Explicit
[/vba]
Результат один и тот же. Код начинает работаеть, Но! он почему-то предлагает название - Книга1-4.xml (четыре раза, ели первые номера уже заняты предлагает следующие 5-9)
А я хотел чтобы названия файлов содержали название текущего файла с допиской названия страницы. Иначе те кто будут использовать запутаются ((((
 
Ответить
Сообщение_Boroda_,
при добавлении [vba]
Код
Dim i as Byte
[/vba] или удалении [vba]
Код
Option Explicit
[/vba]
Результат один и тот же. Код начинает работаеть, Но! он почему-то предлагает название - Книга1-4.xml (четыре раза, ели первые номера уже заняты предлагает следующие 5-9)
А я хотел чтобы названия файлов содержали название текущего файла с допиской названия страницы. Иначе те кто будут использовать запутаются ((((

Автор - koyaanisqatsi
Дата добавления - 10.01.2019 в 09:54
_Boroda_ Дата: Четверг, 10.01.2019, 10:10 | Сообщение № 8
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16674
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Вполне может быть. Я код вообще не смотрел, я ответил только на вопрос про ругань
Для остального нужен файл с кодом
И не нужно было убирать строку сохранения файла
[vba]
Код
wbA.SaveAs bName
    wbA.Close False
[/vba]
А для
Цитата koyaanisqatsi, 10.01.2019 в 09:54, в сообщении № 7 ()
названия файлов содержали название текущего файла с допиской названия страницы
переменную bName нужно сформировать в согласно хотелок. Примерно так
[vba]
Код
bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "")  & a(i) & ".xlsx"
[/vba]
И в коде на скрине внутри цикла почему у Вас а(1) вместо а(i)?

С учетом всего вышеизложенного попробуйте дальше самостоятельно разобраться


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеВполне может быть. Я код вообще не смотрел, я ответил только на вопрос про ругань
Для остального нужен файл с кодом
И не нужно было убирать строку сохранения файла
[vba]
Код
wbA.SaveAs bName
    wbA.Close False
[/vba]
А для
Цитата koyaanisqatsi, 10.01.2019 в 09:54, в сообщении № 7 ()
названия файлов содержали название текущего файла с допиской названия страницы
переменную bName нужно сформировать в согласно хотелок. Примерно так
[vba]
Код
bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "")  & a(i) & ".xlsx"
[/vba]
И в коде на скрине внутри цикла почему у Вас а(1) вместо а(i)?

С учетом всего вышеизложенного попробуйте дальше самостоятельно разобраться

Автор - _Boroda_
Дата добавления - 10.01.2019 в 10:10
koyaanisqatsi Дата: Четверг, 10.01.2019, 10:35 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
Я не удалял этот кусок просто он в скрин не влез. Когда строку заменил на Примерно такую все равно по прописному правилу предлагал сохранять с названием 1-4. И в конце на этой строчке еще дебаг вылез.

[vba]
Код
Option Explicit

Sub Лист_экспорт()
    Dim cPath As String, cPrefix As String, cName As String
    cPath = ThisWorkbook.Path & "\экспорт\"
    cPrefix = "Экспорт "
    cName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    
    Dim wbC As Workbook, wbE As Workbook
    Application.ScreenUpdating = False
    Set wbC = ThisWorkbook
    
    
    Dim a(1 To 4) As String
    a(1) = "ЭкспортБМ"
    a(2) = "ЭкспортЛимак"
    a(3) = "ЭкспортАртис"
    a(4) = "ЭкспортБЗУ"
    
    Dim i As Byte
    For i = 1 To UBound(a)
    Set wbE = Workbooks.Add
    With wbE.Sheets(1)
        .Name = a(i)
        wbC.Sheets(a(i)).Cells.Copy
        .[a1].PasteSpecial xlPasteValues
    End With
     wbE.Close True
    Next i
    Application.DisplayAlerts = False
    
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
  
    
    Dim bPath As String, bPrefix As String, bName As String
    bPath = "D:\ОБЩИЕ_ДОКУМЕНТЫ\Бухгалтерия\Овощи_приход\"
    bPrefix = "БухПриход "
    bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    Debug.Print bName
    Dim wbQ As Workbook, wbA As Workbook
    Application.ScreenUpdating = False
    Set wbQ = ThisWorkbook
    Set wbA = Workbooks.Add
    wbA.Sheets(3).Name = "Экспорт"
    wbQ.Sheets("Экспорт").Cells.Copy
    wbA.Sheets("Экспорт").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.Sheets(1).Name = "БухПрих"
    wbQ.Sheets("БухПрих").Cells.Copy
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteFormats
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    'wbA.Sheets(2).Name = "Выб. БУХ"
    'wbQ.Sheets("Выб. БУХ").Cells.Copy
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteFormats
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.SaveAs bName
    wbA.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    
End Sub

[/vba]
 
Ответить
СообщениеЯ не удалял этот кусок просто он в скрин не влез. Когда строку заменил на Примерно такую все равно по прописному правилу предлагал сохранять с названием 1-4. И в конце на этой строчке еще дебаг вылез.

[vba]
Код
Option Explicit

Sub Лист_экспорт()
    Dim cPath As String, cPrefix As String, cName As String
    cPath = ThisWorkbook.Path & "\экспорт\"
    cPrefix = "Экспорт "
    cName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    
    Dim wbC As Workbook, wbE As Workbook
    Application.ScreenUpdating = False
    Set wbC = ThisWorkbook
    
    
    Dim a(1 To 4) As String
    a(1) = "ЭкспортБМ"
    a(2) = "ЭкспортЛимак"
    a(3) = "ЭкспортАртис"
    a(4) = "ЭкспортБЗУ"
    
    Dim i As Byte
    For i = 1 To UBound(a)
    Set wbE = Workbooks.Add
    With wbE.Sheets(1)
        .Name = a(i)
        wbC.Sheets(a(i)).Cells.Copy
        .[a1].PasteSpecial xlPasteValues
    End With
     wbE.Close True
    Next i
    Application.DisplayAlerts = False
    
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
  
    
    Dim bPath As String, bPrefix As String, bName As String
    bPath = "D:\ОБЩИЕ_ДОКУМЕНТЫ\Бухгалтерия\Овощи_приход\"
    bPrefix = "БухПриход "
    bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    Debug.Print bName
    Dim wbQ As Workbook, wbA As Workbook
    Application.ScreenUpdating = False
    Set wbQ = ThisWorkbook
    Set wbA = Workbooks.Add
    wbA.Sheets(3).Name = "Экспорт"
    wbQ.Sheets("Экспорт").Cells.Copy
    wbA.Sheets("Экспорт").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.Sheets(1).Name = "БухПрих"
    wbQ.Sheets("БухПрих").Cells.Copy
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteFormats
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    'wbA.Sheets(2).Name = "Выб. БУХ"
    'wbQ.Sheets("Выб. БУХ").Cells.Copy
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteFormats
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.SaveAs bName
    wbA.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    
End Sub

[/vba]

Автор - koyaanisqatsi
Дата добавления - 10.01.2019 в 10:35
_Boroda_ Дата: Четверг, 10.01.2019, 11:01 | Сообщение № 10
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16674
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Все это нужно вставить ВМЕСТО
[vba]
Код
wbE.Close True
[/vba]

Вот так должно получиться
[vba]
Код
    For i = 1 To UBound(a)
        Set wbE = Workbooks.Add
        With wbE.Sheets(1)
            .Name = a(i)
            wbC.Sheets(a(i)).Cells.Copy
            .[a1].PasteSpecial xlPasteValues
        End With
        bName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & " " & a(i) & ".xlsx"
        wbE.SaveAs Filename:=bName
        wbE.Close False
    Next i
[/vba]

* И почему бы не сразу копировать нужный лист? Вместо того, чтобы создавать новый и копировать туда всё из нужного листа, как у Вас. Ну да ладно, С тем еще возиться нужно, а это у Вас уже написано


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеВсе это нужно вставить ВМЕСТО
[vba]
Код
wbE.Close True
[/vba]

Вот так должно получиться
[vba]
Код
    For i = 1 To UBound(a)
        Set wbE = Workbooks.Add
        With wbE.Sheets(1)
            .Name = a(i)
            wbC.Sheets(a(i)).Cells.Copy
            .[a1].PasteSpecial xlPasteValues
        End With
        bName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & " " & a(i) & ".xlsx"
        wbE.SaveAs Filename:=bName
        wbE.Close False
    Next i
[/vba]

* И почему бы не сразу копировать нужный лист? Вместо того, чтобы создавать новый и копировать туда всё из нужного листа, как у Вас. Ну да ладно, С тем еще возиться нужно, а это у Вас уже написано

Автор - _Boroda_
Дата добавления - 10.01.2019 в 11:01
koyaanisqatsi Дата: Четверг, 10.01.2019, 11:23 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
Я понимаю что я сделал не правильно. Но я не сильно понимаю что вырезать надо из разных кусков кода.
По этому опять ошибка (
[vba]
Код
Option Explicit

Sub Лист_экспорт()
    Dim cPath As String, cPrefix As String, cName As String
    cPath = ThisWorkbook.Path & "\экспорт\"
    cPrefix = "Экспорт "
    cName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    
    Dim wbC As Workbook, wbE As Workbook
    Application.ScreenUpdating = False
    Set wbC = ThisWorkbook
    
    
    Dim a(1 To 4) As String
    a(1) = "ЭкспортБМ"
    a(2) = "ЭкспортЛимак"
    a(3) = "ЭкспортАртис"
    a(4) = "ЭкспортБЗУ"
    
    Dim i As Byte
   ' For i = 1 To UBound(a)
   ' Set wbE = Workbooks.Add
   ' With wbE.Sheets(1)
   '  .Name = a(i)
   '   wbC.Sheets(a(i)).Cells.Copy
   '    .[a1].PasteSpecial xlPasteValues
   ' End With
   '  wbE.Close True
   'Next i
    
    
        For i = 1 To UBound(a)
        Set wbE = Workbooks.Add
        With wbE.Sheets(1)
            .Name = a(i)
            wbC.Sheets(a(i)).Cells.Copy
            .[a1].PasteSpecial xlPasteValues
        End With
        bName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & " " & a(i) & ".xlsx"
        wbE.SaveAs Filename:=bName
        wbE.Close False
    Next i
    
    
    
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
  
    
    Dim bPath As String, bPrefix As String, bName As String
    bPath = "D:\ОБЩИЕ_ДОКУМЕНТЫ\Бухгалтерия\Овощи_приход\"
    bPrefix = "БухПриход "
    'bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & a(i) & ".xlsx"
    Debug.Print bName
    Dim wbQ As Workbook, wbA As Workbook
    Application.ScreenUpdating = False
    Set wbQ = ThisWorkbook
    Set wbA = Workbooks.Add
    wbA.Sheets(3).Name = "Экспорт"
    wbQ.Sheets("Экспорт").Cells.Copy
    wbA.Sheets("Экспорт").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.Sheets(1).Name = "БухПрих"
    wbQ.Sheets("БухПрих").Cells.Copy
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteFormats
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    'wbA.Sheets(2).Name = "Выб. БУХ"
    'wbQ.Sheets("Выб. БУХ").Cells.Copy
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteFormats
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.SaveAs bName
    wbA.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    
End Sub

[/vba]
 
Ответить
СообщениеЯ понимаю что я сделал не правильно. Но я не сильно понимаю что вырезать надо из разных кусков кода.
По этому опять ошибка (
[vba]
Код
Option Explicit

Sub Лист_экспорт()
    Dim cPath As String, cPrefix As String, cName As String
    cPath = ThisWorkbook.Path & "\экспорт\"
    cPrefix = "Экспорт "
    cName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    
    Dim wbC As Workbook, wbE As Workbook
    Application.ScreenUpdating = False
    Set wbC = ThisWorkbook
    
    
    Dim a(1 To 4) As String
    a(1) = "ЭкспортБМ"
    a(2) = "ЭкспортЛимак"
    a(3) = "ЭкспортАртис"
    a(4) = "ЭкспортБЗУ"
    
    Dim i As Byte
   ' For i = 1 To UBound(a)
   ' Set wbE = Workbooks.Add
   ' With wbE.Sheets(1)
   '  .Name = a(i)
   '   wbC.Sheets(a(i)).Cells.Copy
   '    .[a1].PasteSpecial xlPasteValues
   ' End With
   '  wbE.Close True
   'Next i
    
    
        For i = 1 To UBound(a)
        Set wbE = Workbooks.Add
        With wbE.Sheets(1)
            .Name = a(i)
            wbC.Sheets(a(i)).Cells.Copy
            .[a1].PasteSpecial xlPasteValues
        End With
        bName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & " " & a(i) & ".xlsx"
        wbE.SaveAs Filename:=bName
        wbE.Close False
    Next i
    
    
    
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
  
    
    Dim bPath As String, bPrefix As String, bName As String
    bPath = "D:\ОБЩИЕ_ДОКУМЕНТЫ\Бухгалтерия\Овощи_приход\"
    bPrefix = "БухПриход "
    'bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & a(i) & ".xlsx"
    Debug.Print bName
    Dim wbQ As Workbook, wbA As Workbook
    Application.ScreenUpdating = False
    Set wbQ = ThisWorkbook
    Set wbA = Workbooks.Add
    wbA.Sheets(3).Name = "Экспорт"
    wbQ.Sheets("Экспорт").Cells.Copy
    wbA.Sheets("Экспорт").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.Sheets(1).Name = "БухПрих"
    wbQ.Sheets("БухПрих").Cells.Copy
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteFormats
    wbA.Sheets("БухПрих").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    'wbA.Sheets(2).Name = "Выб. БУХ"
    'wbQ.Sheets("Выб. БУХ").Cells.Copy
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteFormats
    'wbA.Sheets("Выб. БУХ").[a1].PasteSpecial xlPasteValuesAndNumberFormats
    Application.DisplayAlerts = False
    wbA.SaveAs bName
    wbA.Close False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    
End Sub

[/vba]

Автор - koyaanisqatsi
Дата добавления - 10.01.2019 в 11:23
_Boroda_ Дата: Четверг, 10.01.2019, 11:49 | Сообщение № 12
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16674
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
А в нижнем куске почему не убрали то, что навставляли до этого?
Вы куда-то торопитесь? Не стОит, так еще дольше получится


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА в нижнем куске почему не убрали то, что навставляли до этого?
Вы куда-то торопитесь? Не стОит, так еще дольше получится

Автор - _Boroda_
Дата добавления - 10.01.2019 в 11:49
_Boroda_ Дата: Четверг, 10.01.2019, 14:42 | Сообщение № 13
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16674
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
[vba]
Код
'Option Explicit

Sub Лист_экспорт()
    Dim cPath As String, cPrefix As String, cName As String
    cPath = ThisWorkbook.Path & "\экспорт\"
    cPrefix = "Экспорт "
    cName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    Dim wbC As Workbook, wbE As Workbook
    Application.ScreenUpdating = False
    Set wbC = ThisWorkbook
    Dim a(1 To 4) As String
    a(1) = "ЭкспортБМ"
    a(2) = "ЭкспортЛимак"
    a(3) = "ЭкспортАртис"
    a(4) = "ЭкспортБЗУ"
    Application.DisplayAlerts = False
    Dim i As Byte
    For i = 1 To UBound(a)
        Set wbE = Workbooks.Add
        With wbE.Sheets(1)
            .Name = a(i)
            wbC.Sheets(a(i)).Cells.Copy
            .[a1].PasteSpecial xlPasteValues
        End With
        bName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & " " & a(i) & ".xlsx"
        wbE.SaveAs Filename:=bName
        wbE.Close False
    Next i
    bPath = "D:\ОБЩИЕ_ДОКУМЕНТЫ\Бухгалтерия\Овощи_приход\"
    bPrefix = "БухПриход "
    bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    Set wbE = Workbooks.Add
    With wbE
        .Sheets(3).Name = "Экспорт"
        wbC.Sheets("Экспорт").Cells.Copy
        .Sheets("Экспорт").[a1].PasteSpecial xlPasteValuesAndNumberFormats
        .Sheets(1).Name = "БухПрих"
        wbC.Sheets("БухПрих").Cells.Copy
        .Sheets("БухПрих").[a1].PasteSpecial xlPasteFormats
        .Sheets("БухПрих").[a1].PasteSpecial xlPasteValuesAndNumberFormats
        .SaveAs bName
        .Close False
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение[vba]
Код
'Option Explicit

Sub Лист_экспорт()
    Dim cPath As String, cPrefix As String, cName As String
    cPath = ThisWorkbook.Path & "\экспорт\"
    cPrefix = "Экспорт "
    cName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    Dim wbC As Workbook, wbE As Workbook
    Application.ScreenUpdating = False
    Set wbC = ThisWorkbook
    Dim a(1 To 4) As String
    a(1) = "ЭкспортБМ"
    a(2) = "ЭкспортЛимак"
    a(3) = "ЭкспортАртис"
    a(4) = "ЭкспортБЗУ"
    Application.DisplayAlerts = False
    Dim i As Byte
    For i = 1 To UBound(a)
        Set wbE = Workbooks.Add
        With wbE.Sheets(1)
            .Name = a(i)
            wbC.Sheets(a(i)).Cells.Copy
            .[a1].PasteSpecial xlPasteValues
        End With
        bName = cPath & cPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & " " & a(i) & ".xlsx"
        wbE.SaveAs Filename:=bName
        wbE.Close False
    Next i
    bPath = "D:\ОБЩИЕ_ДОКУМЕНТЫ\Бухгалтерия\Овощи_приход\"
    bPrefix = "БухПриход "
    bName = bPath & bPrefix & Replace(ThisWorkbook.Name, ".xlsm", "") & ".xlsx"
    Set wbE = Workbooks.Add
    With wbE
        .Sheets(3).Name = "Экспорт"
        wbC.Sheets("Экспорт").Cells.Copy
        .Sheets("Экспорт").[a1].PasteSpecial xlPasteValuesAndNumberFormats
        .Sheets(1).Name = "БухПрих"
        wbC.Sheets("БухПрих").Cells.Copy
        .Sheets("БухПрих").[a1].PasteSpecial xlPasteFormats
        .Sheets("БухПрих").[a1].PasteSpecial xlPasteValuesAndNumberFormats
        .SaveAs bName
        .Close False
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 10.01.2019 в 14:42
koyaanisqatsi Дата: Четверг, 10.01.2019, 17:21 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, Спасибо огромное. предварительно это работает, требует более детальной проверки которая мне не доступна пока.
 
Ответить
Сообщение_Boroda_, Спасибо огромное. предварительно это работает, требует более детальной проверки которая мне не доступна пока.

Автор - koyaanisqatsi
Дата добавления - 10.01.2019 в 17:21
koyaanisqatsi Дата: Среда, 04.09.2019, 12:10 | Сообщение № 15
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, у меня беда. этот макрос перестал работать. Расскажу по подробнее.
1. Часто слетает автоподсчет формул и перекидывается на ручной режим. Видать превышает какие-то тайменги.
2. Два файла этим макросом делает правильно все копирует и сортирует и удаляет как и запланировано. А два файла Артис и Лимак не сортирует причем самое что печальное нижная строка где команда END для последующей обработки попадает на самый верх . И чтобы воспользоваться последующими выгрузками надо залезать в файл и переставлять строку в самый низ.
уже всю голову сломал. не знаю что и делать. Есть файл за 28.08.2019 четверг. Там все работает. Беру его снова добавляю два контрагента и опять все тоже самое.

Самое интересное что эти два контрагента не из тех файлов которые не сортируются ((((

Может есть какие предположения? Куда поглядеть ? И почему постоянно слетает автоподсчет ? Нельзя увеличить таймауты ?
 
Ответить
Сообщение_Boroda_, у меня беда. этот макрос перестал работать. Расскажу по подробнее.
1. Часто слетает автоподсчет формул и перекидывается на ручной режим. Видать превышает какие-то тайменги.
2. Два файла этим макросом делает правильно все копирует и сортирует и удаляет как и запланировано. А два файла Артис и Лимак не сортирует причем самое что печальное нижная строка где команда END для последующей обработки попадает на самый верх . И чтобы воспользоваться последующими выгрузками надо залезать в файл и переставлять строку в самый низ.
уже всю голову сломал. не знаю что и делать. Есть файл за 28.08.2019 четверг. Там все работает. Беру его снова добавляю два контрагента и опять все тоже самое.

Самое интересное что эти два контрагента не из тех файлов которые не сортируются ((((

Может есть какие предположения? Куда поглядеть ? И почему постоянно слетает автоподсчет ? Нельзя увеличить таймауты ?

Автор - koyaanisqatsi
Дата добавления - 04.09.2019 в 12:10
koyaanisqatsi Дата: Понедельник, 29.05.2023, 15:14 | Сообщение № 16
Группа: Проверенные
Ранг: Ветеран
Сообщений: 713
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
Приношу свои извинения. Похоже все заработало.



Сообщение отредактировал koyaanisqatsi - Понедельник, 29.05.2023, 16:19
 
Ответить
СообщениеПриношу свои извинения. Похоже все заработало.


Автор - koyaanisqatsi
Дата добавления - 29.05.2023 в 15:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Экспорт страниц в отдельные файлы и создание этих файлов (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!