Vba excel скопировать формат ячеек

Remember that when you write:

MyArray = Range("A1:A5000")

you are really writing

MyArray = Range("A1:A5000").Value

You can also use names:

MyArray = Names("MyWSTable").RefersToRange.Value

But Value is not the only property of Range. I have used:

MyArray = Range("A1:A5000").NumberFormat

I doubt

MyArray = Range("A1:A5000").Font

would work but I would expect

MyArray = Range("A1:A5000").Font.Bold

to work.

I do not know what formats you want to copy so you will have to try.

However, I must add that when you copy and paste a large range, it is not as much slower than doing it via an array as we all thought.

Post Edit information

Having posted the above I tried by own advice. My experiments with copying Font.Color and Font.Bold to an array have failed.

Of the following statements, the second would fail with a type mismatch:

  ValueArray = .Range("A1:T5000").Value
  ColourArray = .Range("A1:T5000").Font.Color

ValueArray must be of type variant. I tried both variant and long for ColourArray without success.

I filled ColourArray with values and tried the following statement:

  .Range("A1:T5000").Font.Color = ColourArray

The entire range would be coloured according to the first element of ColourArray and then Excel looped consuming about 45% of the processor time until I terminated it with the Task Manager.

There is a time penalty associated with switching between worksheets but recent questions about macro duration have caused everyone to review our belief that working via arrays was substantially quicker.

I constructed an experiment that broadly reflects your requirement. I filled worksheet Time1 with 5000 rows of 20 cells which were selectively formatted as: bold, italic, underline, subscript, bordered, red, green, blue, brown, yellow and gray-80%.

With version 1, I copied every 7th cells from worksheet «Time1» to worksheet «Time2» using copy.

With version 2, I copied every 7th cells from worksheet «Time1» to worksheet «Time2» by copying the value and the colour via an array.

With version 3, I copied every 7th cells from worksheet «Time1» to worksheet «Time2» by copying the formula and the colour via an array.

Version 1 took an average of 12.43 seconds, version 2 took an average of 1.47 seconds while version 3 took an average of 1.83 seconds. Version 1 copied formulae and all formatting, version 2 copied values and colour while version 3 copied formulae and colour. With versions 1 and 2 you could add bold and italic, say, and still have some time in hand. However, I am not sure it would be worth the bother given that copying 21,300 values only takes 12 seconds.

** Code for Version 1**

I do not think this code includes anything that needs an explanation. Respond with a comment if I am wrong and I will fix.

Sub SelectionCopyAndPaste()

  Dim ColDestCrnt As Integer
  Dim ColSrcCrnt As Integer
  Dim NumSelect As Long
  Dim RowDestCrnt As Integer
  Dim RowSrcCrnt As Integer
  Dim StartTime As Single

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  NumSelect = 1
  ColDestCrnt = 1
  RowDestCrnt = 1
  With Sheets("Time2")
    .Range("A1:T715").EntireRow.Delete
  End With
  StartTime = Timer
  Do While True
    ColSrcCrnt = (NumSelect Mod 20) + 1
    RowSrcCrnt = (NumSelect - ColSrcCrnt) / 20 + 1
    If RowSrcCrnt > 5000 Then
      Exit Do
    End If
    Sheets("Time1").Cells(RowSrcCrnt, ColSrcCrnt).Copy _
                 Destination:=Sheets("Time2").Cells(RowDestCrnt, ColDestCrnt)
    If ColDestCrnt = 20 Then
      ColDestCrnt = 1
      RowDestCrnt = RowDestCrnt + 1
    Else
     ColDestCrnt = ColDestCrnt + 1
    End If
    NumSelect = NumSelect + 7
  Loop
  Debug.Print Timer - StartTime
  ' Average 12.43 secs
  Application.Calculation = xlCalculationAutomatic

End Sub

** Code for Versions 2 and 3**

The User type definition must be placed before any subroutine in the module. The code works through the source worksheet copying values or formulae and colours to the next element of the array. Once selection has been completed, it copies the collected information to the destination worksheet. This avoids switching between worksheets more than is essential.

Type ValueDtl
  Value As String
  Colour As Long
End Type

Sub SelectionViaArray()

  Dim ColDestCrnt As Integer
  Dim ColSrcCrnt As Integer
  Dim InxVLCrnt As Integer
  Dim InxVLCrntMax As Integer
  Dim NumSelect As Long
  Dim RowDestCrnt As Integer
  Dim RowSrcCrnt As Integer
  Dim StartTime As Single
  Dim ValueList() As ValueDtl

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  ' I have sized the array to more than I expect to require because ReDim
  ' Preserve is expensive.  However, I will resize if I fill the array.
  ' For my experiment I know exactly how many elements I need but that
  ' might not be true for you.
  ReDim ValueList(1 To 25000)

  NumSelect = 1
  ColDestCrnt = 1
  RowDestCrnt = 1
  InxVLCrntMax = 0      ' Last used element in ValueList.
  With Sheets("Time2")
    .Range("A1:T715").EntireRow.Delete
  End With
  StartTime = Timer
  With Sheets("Time1")
    Do While True
      ColSrcCrnt = (NumSelect Mod 20) + 1
      RowSrcCrnt = (NumSelect - ColSrcCrnt) / 20 + 1
      If RowSrcCrnt > 5000 Then
        Exit Do
      End If
      InxVLCrntMax = InxVLCrntMax + 1
      If InxVLCrntMax > UBound(ValueList) Then
        ' Resize array if it has been filled 
        ReDim Preserve ValueList(1 To UBound(ValueList) + 1000)
      End If
      With .Cells(RowSrcCrnt, ColSrcCrnt)
        ValueList(InxVLCrntMax).Value = .Value              ' Version 2
        ValueList(InxVLCrntMax).Value = .Formula            ' Version 3
        ValueList(InxVLCrntMax).Colour = .Font.Color
      End With
      NumSelect = NumSelect + 7
    Loop
  End With
  With Sheets("Time2")
    For InxVLCrnt = 1 To InxVLCrntMax
      With .Cells(RowDestCrnt, ColDestCrnt)
        .Value = ValueList(InxVLCrnt).Value                 ' Version 2
        .Formula = ValueList(InxVLCrnt).Value               ' Version 3
        .Font.Color = ValueList(InxVLCrnt).Colour
      End With
      If ColDestCrnt = 20 Then
        ColDestCrnt = 1
        RowDestCrnt = RowDestCrnt + 1
      Else
       ColDestCrnt = ColDestCrnt + 1
      End If
    Next
  End With
  Debug.Print Timer - StartTime
  ' Version 2 average 1.47 secs
  ' Version 3 average 1.83 secs
  Application.Calculation = xlCalculationAutomatic

End Sub

In excel, I am trying to copy text from one cell to another cell in another sheet. The source cell contains formatted text (bold,underlined,different colors). But when I copy the text using VBA to the other cell, the formatting is lost.

I know it is because excel is copying only the text value. Is there a way we can read the HTML text (rather than plain text) from a cell?

I have googled this and did not get any answers. I know that if we use copy and paste methods, we can copy the formatting.
E.g.

Range("F10").Select
Selection.Copy
Range("I10").Select
ActiveSheet.Paste

But I want to do it without a copy and paste since my destination is a merged cell and not identically sized as my source cell. Is there an option available in excel VBA to do this?

EDIT:
I was able to solve it with the following code.

Range("I11").Value = Range("I10").Value
For i = 1 To Range("I10").Characters.Count
    Range("I11").Characters(i, 1).Font.Bold = Range("I10").Characters(i, 1).Font.Bold
    Range("I11").Characters(i, 1).Font.Color = Range("I10").Characters(i, 1).Font.Color
    Range("I11").Characters(i, 1).Font.Italic = Range("I10").Characters(i, 1).Font.Italic
    Range("I11").Characters(i, 1).Font.Underline = Range("I10").Characters(i, 1).Font.Underline
    Range("I11").Characters(i, 1).Font.FontStyle = Range("I10").Characters(i, 1).Font.FontStyle
Next i

Если вы хотите скопировать только форматирование ячейки из диапазона, как это сделать быстро? В этом руководстве представлены быстрые сокращения, позволяющие легко копировать только форматирование.

Копирование форматирования только с помощью Format Painter в Excel

Копировать форматирование только с помощью VBA

Копировать форматирование только с Kutools for Excel хорошая идея3


Копирование форматирования только с помощью Format Painter в Excel

В Excel вы можете копировать форматирование ячеек только с помощью Формат Painter инструмент.

1. Выберите диапазон, содержащий формат ячеек, который вы хотите скопировать. Смотрите скриншот:

2. Применение Формат Painter щелкнув его под Главная вкладку, см. снимок экрана:

3. Выберите пустую ячейку и щелкните по ней, будет вставлено только форматирование ячеек. Смотрите скриншот:

Внимание: Формат Painter также можно копировать форматирование только на другой лист.


Копировать форматирование только с помощью VBA

Следующие макросы также могут помочь вам скопировать только форматирование ячеек.

1. Держать ALT и нажмите F11 на клавиатуре, чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модули, и скопируйте VBA в модуль.

VBA: копировать только форматирование ячеек:

Sub CopyFormat()
'Update 20130815
Dim CopyRng As Range, PasteRng As Range
xTitleId = "KutoolsforExcel"
Set CopyRng = Application.Selection
Set CopyRng = Application.InputBox("Ranges to be copied :", xTitleId, CopyRng.Address, Type:=8)
Set PasteRng = Application.InputBox("Paste to (single cell):", xTitleId, Type:=8)
CopyRng.Copy
PasteRng.Parent.Activate
PasteRng.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End Sub

3. Нажмите Run или нажмите F5 для запуска VBA. На экране отображается диалоговое окно, и вы должны выбрать ячейки, форматирование которых вы хотите скопировать. Смотрите скриншот:

4. Нажмите Ok и другое диалоговое окно отображается для вас, чтобы выбрать ячейку для вставки форматирования. Смотрите скриншот:

6. Нажмите Ok, то форматирование ячеек вставляется в выбранную ячейку. Смотрите скриншот:

 Внимание: С помощью этого кода VBA вы можете вставлять только форматирование в другие рабочие листы, которые вы хотите.


Копировать форматирование только с Kutools for Excel

Есть Kutools for Excel установлен, Копировать диапазоны Функция может помочь вам быстро и легко скопировать только форматирование ячеек.

После установки Kutools for Excel, пожалуйста, сделайте, как показано ниже :( Бесплатная загрузка Kutools for Excel Сейчас!)

Пожалуйста, примените Копировать диапазоны функция, нажав Кутулс > Копировать диапазоны. Смотрите скриншот:

только документ копировать форматирование 9

1. Выделите ячейки, форматирование которых вы хотите скопировать.

2. Нажмите Кутулс > Копировать диапазонs, на экране появится диалог, отметьте Форматы вариант под Специальная вставка, см. снимок экрана:

3. И нажмите ОК. Другой диалог отображается для вас, чтобы выбрать ячейку для вставки результата. Смотрите скриншот:

4. Нажмите Ok, и в выбранную ячейку вставляется только форматирование. Смотрите скриншот:

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

Работы С Нами Kutools for ExcelКопировать диапазоны, вы также можете копировать только значения, формулы или комментарии.

Наконечник.Если вы хотите подсчитать или суммировать ячейки на основе цветов, попробуйте использовать Kutools for ExcelАвтора Считать по цвету как показано на следующем снимке экрана. Полная функция без ограничений в 30 дней, пожалуйста, скачайте и получите бесплатную пробную версию сейчас.

Считать по цвету

В некоторых случаях у вас может быть диапазон значений с несколькими цветами, и вы хотите подсчитывать / суммировать значения на основе одного и того же цвета, как вы можете быстро рассчитать?
Работы С Нами Kutools for Excel‘s Считать по цвету, вы можете быстро выполнить множество вычислений по цвету, а также можете сформировать отчет о рассчитанном результате.

количество документов по цвету


Относительные статьи:

  • Копировать числа без формул в ячейки
  • Копировать только комментарии из ячеек в другую
  • Копировать значения и форматирование в ячейки

Лучшие инструменты для работы в офисе

Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма …
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы… Предотвращение дублирования ячеек; Сравнить диапазоны
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор …
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое …
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом …
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.

вкладка kte 201905


Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

офисный дно

 

itsokay

Пользователь

Сообщений: 12
Регистрация: 05.01.2018

#1

05.01.2018 22:54:41

Господа, доброго времени суток.

Помогите, пожалуйста, вот в таком вопросе :
нужно сделать условно говоря хоткей на функцию формат по образцу, для этого пишу макрос и назначаю на него хоткей.
автозапись предложила копировать формат с помощью функции Selection.Copy и вставлять его функцией

Код
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

Теперь вопрос по части как сделать так, что бы после нажатия хоткея отрабатывалось копирование, а потом после выбора нужной ячейки мышью  скопированный формат применялся к выбранной ячейке ?

Спасибо за ответ.

Изменено: itsokay05.01.2018 23:09:35

 

если Вам интересно изучать программирование — Вы можете экспериментировать с кодом до того времени пока все не получится так, ка Вы того хотите
если Вам нужен результат (скопировать формат какой-то ячейки на группу других ячеек), то для этой цели в Excel есть инструмент «формат по образцу», находится эта кнопка в меню Главная, группа Буфер обмена
на мой взгляд, ни в том ни в другом случае помощь форума Вам не нужна

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

itsokay

Пользователь

Сообщений: 12
Регистрация: 05.01.2018

#3

05.01.2018 23:29:42

Цитата
Ігор Гончаренко написал:
если Вам нужен результат (скопировать формат какой-то ячейки на группу других ячеек), то для этой цели в Excel есть инструмент «формат по образцу»,

инструмент и вправду есть, тут вопрос в том что хочется на него сделать хоткей так как часто им пользуюсь.  

 

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#4

05.01.2018 23:40:40

не знаю что Вы на этом выиграете
используйте это

Код
  If Application.CutCopyMode Then
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
  Else
    Selection.Copy
  End If

вместо Вашего хоткей макроса

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

itsokay

Пользователь

Сообщений: 12
Регистрация: 05.01.2018

Чудно!

Единственный момент это то что приходится дважды нажимать на хоткей (макрос). Задумка была изначально что бы хоткей нажимался один раз (происходит копирование) и потом мышкой выбирается ячейка для вставки формата после чего макрос сам вставляет формат по select мышкой. Как-то так.  

 

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#6

06.01.2018 01:13:59

а теперь это:

Код
  Dim rgF As Range, rg As Range
  On Error Resume Next:  Set rgF = Selection
  Set rg = Application.InputBox("Отметьте диапазон", _
  "Куда положить формат из " & rgF.Address(False, False), Type:=8)
  If rg Is Nothing Then Application.CutCopyMode = False: Exit Sub
  rgF.Copy
  rg.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

itsokay

Пользователь

Сообщений: 12
Регистрация: 05.01.2018

мы наверное немного не понимаем друг друга.
задумка такая: в ячейке А1 нужный формат. К ячейке В1 этот формат нужно применить. Последовательность действий :
1)  ручками выбираем ячейку А1
2) нажимаем хоткей (отрабатывает первая часть макроса по копированию формата с текущей ячейки)
3) ручками выбираем ячейку В1 (отрабатывает вторая часть макроса по вставке формата в указанную ячейку).

 

согласен взаимопонимание стремится к нулю (на этапе, когда люди разговаривают на разных языках — это нормально)
на что заточен предложенный выше макрос:
0. вставляете текст этого макроса вместо тела вашего хоткей макроса
1. отмечаете ЛЮБУЮ ячейку (не обязательно А1, ЛЮБУЮ!)
2. жмете хоткей
3. макрос спрашивает куда скопировать форматот омеченной в п.1 ячейки?
4. отмечаете мишью требуемый диапазон, жмете Ок
5. готово. форматы отмеченной в п.1 ячейки распространены на указанные в п. 4. ячейки
что не так?

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

itsokay

Пользователь

Сообщений: 12
Регистрация: 05.01.2018

#9

07.01.2018 22:32:25

Цитата
Ігор Гончаренко написал:
что не так?

задача макроса свести процесс форматирования к нажатию хоткея + 1 клик мышки. Это должно занимать меньше секунды. В идеале вот так :
0. вставляете текст этого макроса вместо тела вашего хоткей макроса
1. отмечаете ЛЮБУЮ ячейку (не обязательно А1, ЛЮБУЮ!)
2. жмете хоткей

4. отмечаете мишью требуемый диапазон
5. готово. форматы отмеченной в п.1 ячейки распространены на указанные в п. 4. ячейки  

 

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

 

itsokay, фактически Вы хотите хоткей на вызов команды «Формат по образцу». К сожалению, программно активировать кнопку на ленте весьма сложно — обычно используют SendKeys для имитации нажатия клавиш. Но это довольно ненадежный метод. ИМХО наилучший из простых способов описан тут:

https://www.quora.com/What-is-the-shortcut-key-for-format-painter-in-Excel-2010

, Method 2.
Можете посмотреть варианты:

https://www.google.ru/search?q=excel+format+painter+hotkey

 

itsokay

Пользователь

Сообщений: 12
Регистрация: 05.01.2018

#12

08.01.2018 01:33:10

Цитата
Казанский написал:
хоткей на вызов команды «Формат по образцу»

Вот же он по вашей ссылке

Цитата
Add Format painter from Home tab to Quick Access Toolbar and you can assign a custom short cut by clicking one after the other i.e. Alt + User defined Numeric (Example: Alt + 5)

И не нужно никаких макросов. Прелестно!

Казанский

,

Ігор Гончаренко

, благодарю за помощь!

 

r_a_s

Пользователь

Сообщений: 9
Регистрация: 30.08.2018

Добрый День. Уважаемые.
Поделитесь пожалуйста макросом, если не сложно.
Макрос должен копировать формат по образцу из определенного листа. в другой лист. Строго все ячейки должны копироваться в те же ячейки только в другой лист.

 

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#14

02.03.2023 15:06:04

Код
Selection.Copy WorkSheets("ИмяДругогоЛиста").Range(Selection.Cells(1).Address(0,0))

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Skip to content

Excel VBA Copy Range to Another Sheet with Formatting

Home » Excel VBA » Excel VBA Copy Range to Another Sheet with Formatting

  • VBA Copy Range to Another Sheet

Very often we need to copy the Excel Range to another sheet with formatting. We can use VBA to automate this task.  Excel VBA Copy Range to Another Sheet with Formatting macro is explained to know how to copy a range to another worksheet using VBA.

How to Copy Range to Another Sheet with Formatting in Excel VBA

Here is the ‘Excel VBA Copy Range to Another Sheet with Formatting‘ macro to copy a range to another sheet with formatting. You can clearly observe that the Excel VBA is copying the given range to another sheet.

Sub Excel_VBA_Copy_Range_to_Another_Sheet_with_Formatting()
Range("A1:E21").Copy Destination:=Sheets("AnotherSheet").Range("A1")
End Sub

Excel VBA Copy Range to Another Sheet with Formatting

The above example macro will copy the given range to another sheet. Macro will copy the Range A1:A21 and paste at Range A1 of Another Sheet. You can edit the sheet name and range to suit your requirement. You can clearly see form the two sheets and notice these points:

  • The macro is perfectly copying the range of data to another sheet
  • It is also copying the Format of the given range to destination sheet.
  • But not the column width.

How to copy the Excel Range including Column widths

It is easy to copy Excel Range to another sheet with formatting and column widths. We have theree solutions, you can implement one of this to suite your process automation.

Method 1: Using PasteSpecial Method to Copy Range and Paste in Another Sheet with Formatting and Column Widths.

Sub Excel_VBA_Copy_Range_to_Another_Sheet_with_Formatfting_ColumnWidth()

Range("A1:E21").Copy Destination:=Sheets("AnotherSheet").Range("A1")
Range("A1:E21").Copy
Sheets("AnotherSheet").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

End Sub

Excel VBA Copy Range to Another Sheet with Formatting Column Width

Method 3: Copying Entire Range of Columns and Paste in Another Sheet.

We copy entire columns of the required range and paste in another sheet. This approach is useful when there is no other data in both the sheets. This will copy range of data including Formatting and Column Widths. Please check the following macro to copy both formatting and column widths.

Sub Excel_VBA_Copy_Range_to_Another_Sheet_with_FormattingAndColumnWidths()

Range("A:E").Copy Destination:=Sheets("AnotherSheet2").Range("a1")
End Sub

The only change in this method is, removing the row numbers from the ranges (A1:E21) and just using the columns A:E.

Method 3: Explicitly specifying the Column Widths

The following macro will copy the range and paste into another sheet. This will also make copy the Formatting and Column widths of the given Range.

Sub Excel_VBA_Copy_Range_to_Another_Sheet_with_FormattingForEachColumn()
Range("A1:E21").Copy Destination:=Sheets("AnotherSheet").Range("a1")
colCntr = 0
For Each col In Range("A1:E21").Columns
Sheets("AnotherSheet").Range("A1").Offset(1, colCntr).ColumnWidth = col.ColumnWidth
colCntr = colCntr + 1
Next
End Sub

Copy Range Values to Another Sheet with out Formatting in Excel VBA

We may need to copy only the values of the given range to another sheet with no formatting. You can copy and paste only values into the another sheet using Excel VBA.

The following macro will copy a range and paste only values in another sheet.

Range("A1:E21").Copy

Sheets("AnotherSheet").Range("A1").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Copy Formats of a Range to Another Sheet using Excel VBA

Alternatively, we can also paste only the formats of the given range into another sheet. We can copy the range use pastespecial method to paste only formats of the source range using Excel VBA.

Here is the macro will copy a range and paste only the formats in another sheet.

Sheets("AnotherSheet").Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Copy Formulas of a Range to Another Sheet using Excel VBA

Sometimes, we may need copy the formulas of the given range and paste in to another range. PasteSpecial method allows us to paste only Formulas to the target range and sheet using Excel VBA.

Macro to copy the formulas from source range and paste into another range and sheet.

Sheets("AnotherSheet").Range("A1").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

CopyPaste Only the Border of a Range to Another Sheet in Excel VBA

The following macro will help us to copy and paste only the borders of the source range and ignore all other formats. We need this when you wants to maintain same border formats in all our target sheets.

Sheets("AnotherSheet").Range("A1").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


Sheets("AnotherSheet").Range("A1").PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True

Best Practices to follow while Copying Excel Range to another Sheet

Excel VBA macros are very helpfull to copy Excel Range to another sheet. We recommend you to note the below points while automating the copy paste tasks.

  • Clear the Target Range: Always clear the target  range (in Another sheet) before copying and pasting the data. There may be some data or formats avaialbe in the target range. This will make sure that you have same source data in the target sheet. And this will clear any pre formats and reduce the file size.
  • Specify Source and Destination Sheets: Try to specify both of the source and destination sheets. So that you can run your macro from any sheet. If your source range is alwas from active sheet, then do not specify the source sheet.
  • Do not perform any other operations between Copy and Paste. It is noticed many beginners copy the range and do some task and then pasting the values. Excel will turn off the CutCopy mode and no data will be pasted in your destination sheet.
Effortlessly Manage Your Projects and Resources
120+ Professional Project Management Templates!

A Powerful & Multi-purpose Templates for project management. Now seamlessly manage your projects, tasks, meetings, presentations, teams, customers, stakeholders and time. This page describes all the amazing new features and options that come with our premium templates.

Save Up to 85% LIMITED TIME OFFER
Excel VBA Project Management Templates
All-in-One Pack
120+ Project Management Templates
Essential Pack
50+ Project Management Templates

Excel Pack
50+ Excel PM Templates

PowerPoint Pack
50+ Excel PM Templates

MS Word Pack
25+ Word PM Templates

Ultimate Project Management Template

Ultimate Resource Management Template

Project Portfolio Management Templates

Related Posts

  • How to Copy Range to Another Sheet with Formatting in Excel VBA
    • How to copy the Excel Range including Column widths
      • Method 1: Using PasteSpecial Method to Copy Range and Paste in Another Sheet with Formatting and Column Widths.
      • Method 3: Copying Entire Range of Columns and Paste in Another Sheet.
      • Method 3: Explicitly specifying the Column Widths
      • Copy Range Values to Another Sheet with out Formatting in Excel VBA
      • Copy Formats of a Range to Another Sheet using Excel VBA
      • Copy Formulas of a Range to Another Sheet using Excel VBA
      • CopyPaste Only the Border of a Range to Another Sheet in Excel VBA
    • Best Practices to follow while Copying Excel Range to another Sheet

VBA Reference

Effortlessly
Manage Your Projects

120+ Project Management Templates

Seamlessly manage your projects with our powerful & multi-purpose templates for project management.

120+ PM Templates Includes:

One Comment

  1. Jo
    July 10, 2019 at 8:31 AM — Reply

    Clear and very helpful. Thanks for providing a the macro to copy ranges in Excel sheets.

Effectively Manage Your
Projects and  Resources

With Our Professional and Premium Project Management Templates!

ANALYSISTABS.COM provides free and premium project management tools, templates and dashboards for effectively managing the projects and analyzing the data.

We’re a crew of professionals expertise in Excel VBA, Business Analysis, Project Management. We’re Sharing our map to Project success with innovative tools, templates, tutorials and tips.

Project Management
Excel VBA

Download Free Excel 2007, 2010, 2013 Add-in for Creating Innovative Dashboards, Tools for Data Mining, Analysis, Visualization. Learn VBA for MS Excel, Word, PowerPoint, Access, Outlook to develop applications for retail, insurance, banking, finance, telecom, healthcare domains.

Analysistabs Logo

Page load link

VBA Projects With Source Code

3 Realtime VBA Projects
with Source Code!

Take Your Projects To The Next Level By Exploring Our Professional Projects

Go to Top

Должен заметить, что исходный код был совсем не таким, нежели код с локализованной проблемой. Он был намного сложнее. И чтобы его разобрать, нужно было бы копировать 2 экрана исходников. В ряд ли кому-то интересно читать этот бред. Вот результат в одну -две строки, который я дал, мне кажется как раз тот вариант, который достоин публикации на форуме. Или не прав?
Вот весь код:
Public Function aa(aa1 As Integer, aa2 As String) ‘Печать типа
‘aa1 — номер печатаемого типа.
‘aa2 — номер раздела, содержимое которого заполнит таблицу
Const aa3 = 8 ‘ номер строки, с которой рисуется шапка таблицы на листе отрисовки
Const aa4 = 11 ‘ номер колонки, с которой рисуется шапка таблицы на листе
Dim aa5 As Integer ‘ номер строки по листу типы
Dim aa6 As Integer ‘ номер очередного типа в таблице типов
Dim aa7 As Byte ‘ номер активной версии таблицы
Const aa8 = 1 ‘ номер колонки, на листе описателе типов, в которой проставлены номера типов
Const aa9 = 11 ‘ номер строки на листе описателе типов, с которой проставлены номера типов
Dim aa10 As Integer ‘ номер первой строки, принадлежащей данному типу на листе описателе типов
Dim aa11 As Integer ‘ номер текущего типа на листе описателе типов
Dim aa12 As Integer ‘ номер очередной строки, принадлежащей данному типу на листе описателе типов
Const aa13 = 10 ‘ номер колонки, с которой отрисовывается генерируемая таблица
Dim aa14 As Byte ‘ номер колонки, в которой отрисовывается обрабатываемое поле рисуемой таблицы
Const aa15 = 19 ‘номер колонки с текстовым описанием шапок таблиц в таблице-описателе типов.
‘Const aa16 = «Экран» ‘ лист, на котором отрисовывается таблица
Dim aa17 As String ‘шапка очередной колонки
Dim aa18 As Byte ‘ ширина очередного столбца
Const aa19 = 12 ‘ номер колонки, в которую прописывается ширина колонок в описателе таблиц
Const aa20 = 25 ‘ номер колонки, в которую прописывается формат ячеек колонок в описателе таблиц
Dim aa21 As Range ‘формат ячеек
aa5 = 10
aa6 = Worksheets(«Типы»).Cells(aa5, 2)

While aa6 <> 0 And aa6 <> aa1
aa5 = aa5 + 1
aa6 = Worksheets(«Типы»).Cells(aa5, 2)
Wend
If aa6 <> 0 Then ‘значит тип идентифицирован. он в aa5 строке
aa7 = Worksheets(«Типы»).Cells(aa6, 9)
If aa7 = 0 Then Worksheets(«Типы»).Cells(aa6, 9) = 1: aa7 = 1 ‘если версия не проставлена- значит проставить первую
aa10 = aa9
aa11 = Worksheets(«Описатель типов»).Cells(aa10, aa8)
While aa11 <> 0 And aa11 <> aa1
aa10 = aa10 + 1
aa11 = Worksheets(«Описатель типов»).Cells(aa10, aa8)
Wend
If aa11 = aa1 Then ‘найдена соответствующая строка в таблице-описателе типов.
‘Прорисовываем шапку раздела
aa12 = aa10
aa11 = Worksheets(«Описатель типов»).Cells(aa12, aa8)
While aa11 = aa1
aa14 = aa13 — 1 + Worksheets(«Описатель типов»).Cells(aa12, 2 + aa7)
aa17 = Worksheets(«Описатель типов»).Cells(aa12, aa15)
Worksheets(aa16).Cells(aa3, aa14) = aa17
aa18 = Worksheets(«Описатель типов»).Cells(aa12, 12)
‘прорисовка формата заголовка (with не использую, так как тут тоже глюки были, решил коряво прописать — лишь бы работало.
Worksheets(aa16).Cells(aa3, aa14).ColumnWidth = aa18
Worksheets(aa16).Cells(aa3, aa14).NumberFormat = «@»
Worksheets(aa16).Cells(aa3, aa14).HorizontalAlignment = xlCenter
Worksheets(aa16).Cells(aa3, aa14).VerticalAlignment = xlCenter
Worksheets(aa16).Cells(aa3, aa14).WrapText = True
Worksheets(aa16).Cells(aa3, aa14).Orientation = 90
Worksheets(aa16).Cells(aa3, aa14).AddIndent = False
Worksheets(aa16).Cells(aa3, aa14).IndentLevel = 0
Worksheets(aa16).Cells(aa3, aa14).ShrinkToFit = False
Worksheets(aa16).Cells(aa3, aa14).ReadingOrder = xlContext
Worksheets(aa16).Cells(aa3, aa14).MergeCells = False
‘копирование формата ячеек колонки в первую строку данных

[COLOR=skyblue]aa21 = Worksheets(«Описатель типов»).Range(Cells(aa12, aa20), Cells(aa12, aa20))[/COLOR]’ эта строка и есть причина ошибки. Она прописывалась по разному, в том числе и через Copy.
Worksheets(aa16).Cells(aa3 + 2, aa14) = aa21
aa12 = aa12 + 1
aa11 = Worksheets(«Описатель типов»).Cells(aa12, aa8)
Wend
Else
‘нет такого типа в таблице описания известных типов
End If

Else
‘нет такого типа в таблице известных типов
End If
End Function

Ну как? Извиняюсь за корявое программирование. Варюсь в собственном соку. И книг по VBA и объектному программированию не читал.

.Tima

5 / 5 / 0

Регистрация: 21.09.2012

Сообщений: 37

1

Скопировать содержимое ячейки с форматированием

03.03.2014, 13:10. Показов 8208. Ответов 9

Метки нет (Все метки)


Студворк — интернет-сервис помощи студентам

Как скопировать содержимое ячейки с форматированием на visual basic в excel?
Операция

Visual Basic
1
myS.Range(Ch & i) = mySE.Range(Ch & j)

или

Visual Basic
1
myS.Range(Ch & i).copy mySE.Range(Ch & j)

копирует только содержимое без форматирования.



0



Апострофф

Заблокирован

03.03.2014, 13:19

2

Цитата
Сообщение от .Tima
Посмотреть сообщение

Visual Basic
1
myS.Range(Ch & i).copy mySE.Range(Ch & j)

копирует с форматированием



1



15136 / 6410 / 1730

Регистрация: 24.09.2011

Сообщений: 9,999

03.03.2014, 13:19

3

Лучший ответ Сообщение было отмечено .Tima как решение

Решение

Второе как раз с форматированием, кроме ширины столбца и высоты строки. i -> j. А первое j -> i, может в этом загвоздка.



1



mc-black

2784 / 716 / 106

Регистрация: 04.02.2011

Сообщений: 1,443

03.03.2014, 13:25

4

Второй вариант копирует и вставляет с форматированием. Если в диапазоне только одна ячейка, адресовать её удобней так:

Visual Basic
1
myS.Cells(srcRow, srcColumn).Copy mySE.Cells(dstRow, dstColumn)

где srcRow, dstRow — номер строки для ячейки, а srcColumn, dstColumn — номер столбца (в режиме показа ссылок R1C1).

P.S. С ответом опоздал



1



5 / 5 / 0

Регистрация: 21.09.2012

Сообщений: 37

03.03.2014, 14:12

 [ТС]

5

Цитата
Сообщение от Казанский
Посмотреть сообщение

Второе как раз с форматированием, кроме ширины столбца и высоты строки. i -> j. А первое j -> i, может в этом загвоздка.

Так и было, спасибо всем за помощь!

Цитата
Сообщение от mc-black
Посмотреть сообщение

Если в диапазоне только одна ячейка, адресовать её удобней так:

У меня адрес ячейки формируется из буквы и цифры, и как я понял, в данном случае можно лишь так:
myS.Range(Ch & i)
или можно иняче?



0



KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

03.03.2014, 15:07

6

Visual Basic
1
myS.Cells(i, Ch).Copy mySE.Cells(j, Ch)



1



5 / 5 / 0

Регистрация: 21.09.2012

Сообщений: 37

07.03.2014, 00:29

 [ТС]

7

Код

myS.Range(Ch & i).copy mySE.Range(Ch & j)

Копирует содержимое ячейки «формулой», а нужно «значением». Как быть?



0



KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

07.03.2014, 12:38

8

Visual Basic
1
 mySE.Range(Ch & j)=myS.Range(Ch & i)



1



5 / 5 / 0

Регистрация: 21.09.2012

Сообщений: 37

07.03.2014, 13:09

 [ТС]

9

Цитата
Сообщение от KoGG
Посмотреть сообщение

mySE.Range(Ch & j)=myS.Range(Ch & i)

Логично, но тогда не копируется форматирование.

Как я понимаю, для того, чтобы скопировать содержимое «значением» с форматированием нужно выполнить две операции:

Код

myS.Range(Ch & i).copy mySE.Range(Ch & j)
mySE.Range(Ch & j)=myS.Range(Ch & i)

Мысль в верном направлении?



0



KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

07.03.2014, 20:30

10

Можно так, либо эдак:

Visual Basic
1
2
myS.Range(Ch & i).Copy
mySE.Range(Ch & j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False



2



Вырезание, перемещение, копирование и вставка ячеек (диапазонов) в VBA Excel. Методы Cut, Copy и PasteSpecial объекта Range, метод Paste объекта Worksheet.

Метод Range.Cut

Range.Cut – это метод, который вырезает объект Range (диапазон ячеек) в буфер обмена или перемещает его в указанное место на рабочем листе.

Синтаксис

Параметры

Параметры Описание
Destination Необязательный параметр. Диапазон ячеек рабочего листа, в который будет вставлен (перемещен) вырезанный объект Range (достаточно указать верхнюю левую ячейку диапазона). Если этот параметр опущен, объект вырезается в буфер обмена.

Для вставки на рабочий лист диапазона ячеек, вырезанного в буфер обмена методом Range.Cut, следует использовать метод Worksheet.Paste.

Метод Range.Copy

Range.Copy – это метод, который копирует объект Range (диапазон ячеек) в буфер обмена или в указанное место на рабочем листе.

Синтаксис

Параметры

Параметры Описание
Destination Необязательный параметр. Диапазон ячеек рабочего листа, в который будет вставлен скопированный объект Range (достаточно указать верхнюю левую ячейку диапазона). Если этот параметр опущен, объект копируется в буфер обмена.

Метод Worksheet.Paste

Worksheet.Paste – это метод, который вставляет содержимое буфера обмена на рабочий лист.

Синтаксис

Worksheet.Paste (Destination, Link)

Метод Worksheet.Paste работает как с диапазонами ячеек, вырезанными в буфер обмена методом Range.Cut, так и скопированными в буфер обмена методом Range.Copy.

Параметры

Параметры Описание
Destination Необязательный параметр. Диапазон (ячейка), указывающий место вставки содержимого буфера обмена. Если этот параметр не указан, используется текущий выделенный объект.
Link Необязательный параметр. Булево значение, которое указывает, устанавливать ли ссылку на источник вставленных данных: True – устанавливать, False – не устанавливать (значение по умолчанию).

В выражении с методом Worksheet.Paste можно указать только один из параметров: или Destination, или Link.

Для вставки из буфера обмена отдельных компонентов скопированных ячеек (значения, форматы, примечания и т.д.), а также для проведения транспонирования и вычислений, используйте метод Range.PasteSpecial (специальная вставка).

Примеры

Вырезание и вставка диапазона одной строкой (перемещение):

Range(«A1:C3»).Cut Range(«E1»)

Вырезание ячеек в буфер обмена и вставка методом ActiveSheet.Paste:

Range(«A1:C3»).Cut

ActiveSheet.Paste Range(«E1»)

Копирование и вставка диапазона одной строкой:

Range(«A18:C20»).Copy Range(«E18»)

Копирование ячеек в буфер обмена и вставка методом ActiveSheet.Paste:

Range(«A18:C20»).Copy

ActiveSheet.Paste Range(«E18»)

Копирование одной ячейки и вставка ее данных во все ячейки заданного диапазона:

Range(«A1»).Copy Range(«B1:D10»)


Like this post? Please share to your friends:
  • Vba excel скопировать формат строки
  • Vba excel скопировать файл не открывая
  • Vba excel скопировать только формулы
  • Vba excel скопировать столбец в другую книгу
  • Vba excel скопировать столбец в другой столбец