Как скопировать ширину и высоту ячеек на все листы ?

Программирование на Visual Basic for Applications
giaber
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 107
Зарегистрирован: 14.01.2009 (Ср) 13:51

Как скопировать ширину и высоту ячеек на все листы ?

Сообщение giaber » 02.01.2023 (Пн) 7:24

Как макросом скопировать ширину и высоту ячеек активного листа на все остальные листы ? На активном листе имеются объединеные ячейки
Спасибо

Template
Обычный пользователь
Обычный пользователь
 
Сообщения: 73
Зарегистрирован: 09.09.2006 (Сб) 18:03

Re: Как скопировать ширину и высоту ячеек на все листы ?

Сообщение Template » 05.01.2023 (Чт) 14:19

Если можно скопировать и другие параметры форматирования, то использовать Специальную вставку - Форматы.

Код: Выделить всё
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = ActiveSheet: ws1.Cells.Copy
For Each ws2 In ActiveWorkbook.Worksheets
    If Not ws1 Is ws2 Then ws2.Cells.PasteSpecial xlPasteFormats 'xlPasteColumnWidths
Next
Application.CutCopyMode = False


Если же только ширину столбцов, то также Специальная вставка - Ширина столбцов. Правда в последнем случае, высота строк не копируется.

giaber
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 107
Зарегистрирован: 14.01.2009 (Ср) 13:51

Re: Как скопировать ширину и высоту ячеек на все листы ?

Сообщение giaber » 06.01.2023 (Пт) 22:27

Template! Большое спасибо!

Template
Обычный пользователь
Обычный пользователь
 
Сообщения: 73
Зарегистрирован: 09.09.2006 (Сб) 18:03

Re: Как скопировать ширину и высоту ячеек на все листы ?

Сообщение Template » 07.01.2023 (Сб) 1:25

На всякий случай - Если листов много, то примерно так можно установить во всех рабочих листах нужную высоту строк и ширину столбцов. А если кроме активного только один лист, то и коллекция не нужна.

Код: Выделить всё
Sub Test()
   
    Dim colHeight As New Collection
    Dim colWidth  As New Collection, i As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rSource As Range, rTemp As Range
   
    Set ws1 = ActiveWorkbook.ActiveSheet
    Set rSource = ws1.Range(ws1.Cells(1), ws1.UsedRange)
   
    For Each rTemp In rSource.Rows
        colHeight.Add rTemp.RowHeight
    Next
   
    For Each rTemp In rSource.Columns
        colWidth.Add rTemp.ColumnWidth
    Next
   
    For Each ws2 In ActiveWorkbook.Worksheets
        If Not (ws2 Is ws1) Then
           For i = 1 To colHeight.Count
               ws2.Rows(i).RowHeight = colHeight(i)
           Next
           For i = 1 To colWidth.Count
               ws2.Columns(i).ColumnWidth = colWidth(i)
           Next
        End If
    Next

End Sub

giaber
Продвинутый пользователь
Продвинутый пользователь
 
Сообщения: 107
Зарегистрирован: 14.01.2009 (Ср) 13:51

Re: Как скопировать ширину и высоту ячеек на все листы ?

Сообщение giaber » 07.01.2023 (Сб) 12:56

Еще раз большое большое спасибо!


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 13

    TopList