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

[giaber]

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

[Template]

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

Код: Выделить всё

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]

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

[Template]

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

Код: Выделить всё

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]

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