VBA Excel - 复制和粘贴列宽/分组答案

【问题标题】：VBA Excel - Copying and Pasting Column Width/GroupingsVBA Excel - 复制和粘贴列宽/分组
【发布时间】：2018-08-29 21:59:01
【问题描述】：

我正在尝试将整个工作表从“DNU”复制到每个进行中的工作表中。我希望定期粘贴以保持宽度和分组，但这只会粘贴公式和表格格式。谢谢。

代码如下：

Dim wsVar As Worksheet
Dim i as Integer
With ThisWorkbook
    For i = 6 to .Worksheets.Count
        .Worksheets("DNU").Range("A1:Y200").Copy destination:=.Worksheets(i).Range("A1:Y200")
    Next 
End With

【问题讨论】：

根据工作表的不同，可能更容易复制工作表并清除不需要的内容。这将保留所有格式

标签： vba excel loops copy-paste

【解决方案1】：

您不需要使用copy/paste。 Value 可以有 arguments、11 传输值和格式。

Dim i As Integer
With ThisWorkbook
    For i = 2 To .Worksheets.Count
        .Worksheets(i).Range("A1:Y200").Value(11) = .Worksheets("Sheet1").Range("A1:Y200").Value(11)
        'Unsure how you accomplish your grouping,
        .Worksheets(i).Range("A1:Y200").OutlineLevel = .Worksheets("Sheet1").Range("A1:Y200").OutlineLevel

        Dim colx As Long
        For colx = 1 To 25
            Worksheets(i).Columns(colx).ColumnWidth = Worksheets("Sheet1").Columns(colx).ColumnWidth
            Worksheets(i).Columns(colx).OutlineLevel = Worksheets("Sheet1").Columns(colx).OutlineLevel
        Next

        Dim rowx As Long
        For rowx = 1 To 200
            Worksheets(i).Rows(rowx).OutlineLevel = Worksheets("Sheet1").Rows(rowx).OutlineLevel
        Next

    Next
End With

【讨论】：

谢谢！格式保持不变，但由于某种原因，分组消失了。有没有办法包含“DNU”工作表中的分组？还是必须为每个工作表自动化？
@Hiimtroymcclure;我更新了答案以复制您的分组。我不使用组，所以它可能不起作用。请在副本上使用它。如果它不起作用，您可能必须使用 vba 重新应用您的组。
感谢 GMalc，我遇到了运行时错误：无法获取 Range 类的 OutlineLevel 属性。就像你提到的那样，我可能不得不重新应用分组。