Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Скопировать данные с одного листа на другой пропуская скрытые сторбцы
 
#1
20.03.2011 21:04:33
Есть лист "прайс" все данные с него нужно перенести на лист "на отправку"  
Приэтом нужно копировать только Видимые столбцы    
а также переносить не формулы а значения.  
 
PS тоесть лист "на отправку" для клиентов они не должны поличить ничего лишнего.
 
 
 
#2
20.03.2011 21:45:59
Как копирует вместе в формулами и скрытыми солбцами  
 
Range("A1:V200").Copy Worksheets("На отправку").Range("A1")  
 
Может ключи есть    
-копировать только видимые  
-втровлять значения без формул
 
 
 
#3
20.03.2011 21:49:43
alex-delphi  
Запишите макрорекордером  
Выделяете диапазон, F5 кнопка выделить - только видимые  
Копируете  
Переходите на новый лист и в А1 правым мышом - специальная вставка и    
сначала - ширина столбцов  
потом значения  
потом форматы  
-------------  
далее полученный код напильником:)
 
 
 
#4
20.03.2011 21:50:08
Нашол копирует только видимые и не переносит формулы.  
 
Range("A1:V200").SpecialCells(xlVisible).Copy Worksheets("Íà îòïðàâêó").Range("A1")  
 
Осталос. только узгнать как ширину сорбцов учитывать.
 
 
 
#5
20.03.2011 21:53:20
"втровлять" - это хорошо, конечно, а у Вас нет возможности показать вариант для 2003?  
P.S. втровлять = вставлять? :=)
 
 
 
#6
20.03.2011 22:07:52
Application.Goto Reference:="Print_Area"  
   Selection.Copy  
     
   Sheets("На отправку").Range("B6").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False  
   Sheets("На отправку").Range("B6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False  
 
Макрокодер предложиол так только он скрытоые тоже копирует.  
 
PS да это вставлять)) Прикрипляю фаил в 2003.  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>
 
 
 
#7
20.03.2011 22:08:20
alex-delphi  
Есть такое меню - СПЕЦИАЛЬНАЯ ВСТАВКА  
а Ваш супер макрос в итоге будет выглядеть примерно так  
Sub Test()  
'  
 
Range("A1:V200").SpecialCells(xlVisible).Copy  
 With Sheets("Íà îòïðàâêó")  
   .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _  
       SkipBlanks:=False, Transpose:=False  
   .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
   .Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _  
       SkipBlanks:=False, Transpose:=False  
  End With  
End Sub
 
 
 
#8
20.03.2011 22:09:22
Xmthn gjlmthb  
 
Sub Макрос2()  
'  
' Макрос2 Макрос  
'  
 
Range("A1:V200").SpecialCells(xlVisible).Copy  
 With Sheets("На отправку")  
   .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _  
       SkipBlanks:=False, Transpose:=False  
   .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
   .Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _  
       SkipBlanks:=False, Transpose:=False  
  End With  
End Sub
 
 
 
#9
20.03.2011 22:09:43
Worksheets("На отправку").Columns.AutoFit  
?
Я сам - дурнее всякого примера! ...
 
 
 
#10
20.03.2011 22:13:37
{quote}{login=Igor67}{date=20.03.2011 10:08}{thema=}{post}  
 With Sheets("Íà îòïðàâêó")  
{/post}{/quote}  
Игорь, глянь сюда, по-поводу иероглифов: http://www.planetaexcel.ru/forum.php?thread_id=11785&page_forum=12&allnum_forum=349
Я сам - дурнее всякого примера! ...
 
 
 
#11
20.03.2011 22:18:05
{quote}{login=KukLP}{date=20.03.2011 10:09}{thema=}{post}Worksheets("На отправку").Columns.AutoFit  
?{/post}{/quote}  
 
А можно прокоментировать?
 
 
 
#12
20.03.2011 22:20:51
Тему смотрел, но там - "Для Висты. Не знаю сработает ли на семерке."  
А у меня 7 и проверять пока не хочу.
 
 
 
#13
20.03.2011 22:21:26
{quote}{login=Igor67}{date=20.03.2011 10:09}{thema=}{post}Xmthn gjlmthb  
 
Sub Макрос2()  
'  
' Макрос2 Макрос  
'  
 
Range("A1:V200").SpecialCells(xlVisible).Copy  
 With Sheets("На отправку")  
   .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _  
       SkipBlanks:=False, Transpose:=False  
   .Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
   .Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _  
       SkipBlanks:=False, Transpose:=False  
  End With  
End Sub{/post}{/quote}  
 
 
Спасибо макрос хорошо работает, единственно что чуть медленее чем  
Range("A1:V200").SpecialCells(xlVisible).Copy Worksheets("На отправку").Range("A1")  
Может в эту команду можно прото ключик дописать чтобы ширина строк встовлялясь.
 
 
 
#14
20.03.2011 22:25:52
alex-delphi Вас не поймешь:)  
То Вам только значения надо вставить, то на скорость кода который это делает жалуетесь:)  
Попробуйте поставить в начало кода    
Application.ScreenUpdating = False  
в конце хорошим тоном считается вернуть назад
 
 
 
#15
20.03.2011 22:27:06
"хорошо работает, единственно что чуть медленее чем..."  
 
Руками разве быстрее? Да и разве получатель не умеет двигать ширину столбца? :-) Вы же не на печать выводите.  
Не проверял, но, может быть, предварительно установленное свойство "автоподбор ширины" в целевой ячейке сработает.
 
 
 
#16
20.03.2011 22:28:17
Range("A1:V200").SpecialCells(xlVisible).Copy Worksheets("На отправку").Range("A1")  
Может в эту команду можно прото ключик дописать чтобы ширина строк встовлялясь.  
Вот после нее и попробуйте вставить:  
Worksheets("На отправку").Columns.AutoFit  
У меня 2003 и Ваши контролы он воспринимает как картинки.
Я сам - дурнее всякого примера! ...
 
 
 
#17
20.03.2011 22:31:37
Спасибо всем!!! Очень профиссионально! Все получилось!
 
 
 
#18
20.03.2011 22:34:06
Для себя примерно так бы сделал - это без определения границ данных.  
Это часть про напильник  
Sub Макрос2()  
'  
Application.ScreenUpdating = False  
Range("A1:V200").SpecialCells(xlVisible).Copy  
 With Sheets("На отправку")  
   .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths  
   .Range("A1").PasteSpecial Paste:=xlPasteValues  
   .Range("A1").PasteSpecial Paste:=xlPasteFormats  
  End With  
  Application.CutCopyMode = False  
  Application.ScreenUpdating = True  
End Sub
 
 
 
Страницы: 1
Читают тему
Наверх