powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Если хотите можете помочь !!!
9 сообщений из 9, страница 1 из 1
Если хотите можете помочь !!!
    #34626054
VladimirSk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Условия:
Два листа
1 - таблица с формулами (общитывает данные запоса)
2 - диаграмма


Вопрос к желающим помочь : -

как скопировать или экспортировать макросом в другую книгу
содержимое 1 листа без формул (таблица) с сохранением форматирования, и особенно интересно содержимое 2 листа на второй же лист новой книги ?

Благодарность моя не для знающих и молчащих, но для ответивших.
Дай Вам Бог здоровья !!!
...
Рейтинг: 0 / 0
Если хотите можете помочь !!!
    #34626156
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
Sub Макрос2()
  Sheets(Array("Лист1", "Лист2")).Select
  Sheets(Array("Лист1", "Лист2")).Copy
    For Each iSheet In Sheets(Array("Лист1", "Лист2"))
     With iSheet.UsedRange
       .Value = .Value
     End With
    Next
End Sub
...
Рейтинг: 0 / 0
Если хотите можете помочь !!!
    #34626161
VladimirSk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Нужно отметить, что таблицу я скопировал, Слава Богу !
А вот картинку-графика заело.
Подскажите как определить, что картинка и применить иной способ копирования ?
...
Рейтинг: 0 / 0
Если хотите можете помочь !!!
    #34626286
VladimirSk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вариант шикарный конечно !
Но в нем формулы все на месте остались .
И на 3 строке кода FOR ...... ошибка 9
...
Рейтинг: 0 / 0
Если хотите можете помочь !!!
    #34626318
VladimirSk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Может код так должен выглядеть


Deggasad
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Sub Макрос2()
  Sheets(Array("Лист1", "Лист2")).Select
 
    For Each iSheet In Sheets(Array("Лист1", "Лист2"))
     With iSheet.UsedRange
       .Value = .Value
     End With
    Next
 Sheets(Array("Лист1", "Лист2")).Copy
End Sub


иначе 2 строки делают копию книги, а дальше ошибку пишет
...
Рейтинг: 0 / 0
Если хотите можете помочь !!!
    #34626413
VladimirSk
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Да !!!
Так заработало и всё вроде правильно.
Успехов Вам Deggasad - Жаль что имени не называете.
Благодарю Вас за протянутую руку помощи !!!
...
Рейтинг: 0 / 0
Если хотите можете помочь !!!
    #34627001
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
VladimirSkДа !!!
Так заработало и всё вроде правильно.
Успехов Вам Deggasad - Жаль что имени не называете.
Благодарю Вас за протянутую руку помощи !!!

А код в модуле или на листе?
Ошибок не должно быть по идее!
Такой вариант может сойти только нужно не забывать текущую книгу без сохранения закрыть!
...
Рейтинг: 0 / 0
Если хотите можете помочь !!!
    #34627672
Rambler
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вы правы с кодом на листе.
На листе был ещё выпадающий список он и проблемы создавал , как я понял.
На данный момент :
Deggasad
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
Sub Макрос21()
    Dim prm_name As String
    Dim MyPath As String
    
    MyPath = "\\Net path\"
    
  Sheets(Array( 2 ,  3 ,  4 ,  5 ,  6 ,  7 ,  8 ,  9 ,  11 ,  12 ,  13 ,  14 )).Select

    For Each iSheet In Sheets(Array( 2 ,  3 ,  4 ,  5 ,  6 ,  7 ,  8 ,  9 ,  11 ,  12 ,  13 ,  14 ))
   
    With iSheet.UsedRange
       .Value = .Value
     End With
    Next
  Sheets(Array( 1 ,  2 ,  3 ,  4 ,  8 ,  9 ,  10 ,  11 ,  12 )).Copy
            'сохраняем с именем в котором значение ячейки J1 (там дата вида 03.06.2007)
  k = Worksheets( 1 ).Range("J1").Value
  
      ChDir "\\Net path\"
    ActiveWorkbook.SaveAs Filename:= _
        MyPath & Mid(k,  1 ,  2 ) & "-" & Mid(k,  4 ,  2 ) & "-" & Mid(k,  7 ,  4 ) & "_test .xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    
End Sub


Всё работает как нужно СПАСИБО ВАМ !!!
...
Рейтинг: 0 / 0
Если хотите можете помочь !!!
    #34627691
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
RamblerВы правы с кодом на листе.
На листе был ещё выпадающий список он и проблемы создавал , как я понял.
На данный момент :
Deggasad
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
Sub Макрос21()
    Dim prm_name As String
    Dim MyPath As String
    
    MyPath = "\\Net path\"
    
  Sheets(Array( 2 ,  3 ,  4 ,  5 ,  6 ,  7 ,  8 ,  9 ,  11 ,  12 ,  13 ,  14 )).Select

    For Each iSheet In Sheets(Array( 2 ,  3 ,  4 ,  5 ,  6 ,  7 ,  8 ,  9 ,  11 ,  12 ,  13 ,  14 ))
   
    With iSheet.UsedRange
       .Value = .Value
     End With
    Next
  Sheets(Array( 1 ,  2 ,  3 ,  4 ,  8 ,  9 ,  10 ,  11 ,  12 )).Copy
            'сохраняем с именем в котором значение ячейки J1 (там дата вида 03.06.2007)
  k = Worksheets( 1 ).Range("J1").Value
  
      ChDir "\\Net path\"
    ActiveWorkbook.SaveAs Filename:= _
        MyPath & Mid(k,  1 ,  2 ) & "-" & Mid(k,  4 ,  2 ) & "-" & Mid(k,  7 ,  4 ) & "_test .xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    
End Sub


Всё работает как нужно СПАСИБО ВАМ !!!

1) Я бы всё таки поместил код в модуль.
2) Всё таки нужно добиваться чтобы сначала копировать листы а потом формулы обрубать, а то глаз режет!
...
Рейтинг: 0 / 0
9 сообщений из 9, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Если хотите можете помочь !!!
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]